home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / mplbas.zip / RBBSSUB5.BAS < prev    next >
BASIC Source File  |  1989-09-26  |  95KB  |  2,635 lines
  1. ' $linesize:132
  2. ' $title: 'RBBSSUB5.BAS CPC17.2B, Copyright 1986 - 89 by D. Thomas Mack'
  3. '  Copyright 1989 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB5.BAS
  5. '  Written by .........: D. Thomas Mack
  6. '  First Released .....: May 28, 1989
  7. '  Subsequent Releases.: 07-30-89
  8. '  Copyright ..........: 1986 - 1989
  9. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  10. '     RBBS-PC.BAS utilizes a lot of common subroutines.  Those that do not
  11. '     require error trapping are incorporated within RBBSSUB 2-5 as
  12. '     separately callable subroutines in order to free up as much
  13. '     code as possible within the 64K code segment used by RBBS-PC.BAS.
  14. '  Parameters..........: Most parameters are passed via a COMMON statement.
  15. '
  16. ' Subroutine  Line               Function of Subroutine
  17. '   Name     Number
  18. '  BRKFNAME   63300   Break file name into component parts
  19. '  BUFASUNIT  63500   Buffer out a string with CR's
  20. '  CALLOPT    63470   Set prompts based on the user's security
  21. '  DOORRTN    63100   Process door requests
  22. '  FILESYS    20117   File System for RBBS-PC
  23. '  FINDIT             Check whether file exists and if so open as #2
  24. '  FORMREAD   63420   Read from file into a form
  25. '  LOCKAPPND  63400   Prepare for a file append
  26. '  MACROEXE   63460   Execute internal macro rather than user
  27. '  NOPATH     63480   Detects whether string has a path in it
  28. '  RESTORECOM 63310   Restore comm port after external program
  29. '  READMACRO  63330   Read and process macro
  30. '  SHELLEXIT  63320   Exit RBBS via shell
  31. '  UNLKAPPND  63410   Clean up after file append
  32. '  WILDCARD   63200   Match string to a pattern
  33. '
  34. '  $INCLUDE: 'RBBS-VAR.BAS'
  35. '
  36. 20117 ' $SUBTITLE: 'FILESYS -- subroutine for RBBS-PC's file system'
  37. ' $PAGE
  38. '
  39. ' NAME    -- FILESYS
  40. '
  41. ' INPUTS  --       PARAMETER                 MEANING
  42. '             FILESYS.PARAMETER = 1  LIST THE SYSOP'S COMMENTS FILE
  43. '                                 2  L)IST DIRECTORY COMMAND
  44. '                                 3  D)OWNLOAD COMMAND
  45. '                                 4  RETURN FROM EXTERNAL PROTOCOLS
  46. '                                 5  U)PLOAD COMMAND
  47. '                                 6  S)CAN DIRECTORY COMMAND
  48. '                                 7  P)ERSONAL FILES COMMAND
  49. '                                 8  N)EW FILES COMMAND
  50. '                                 9  RETURN FROM EXTENDED DESCRIPTION
  51. '
  52. ' OUTPUTS -- FILESYS.PARAMETER = 1  COMMAND PROCESSED SUCCESSFULLY
  53. '                                2  RECYCLE TO TOP OF RBBS-PC (202)
  54. '                                3  PROCESS NEXT COMMAND (1200)
  55. '                                4  DENY USER ACCESS (1380)
  56. '                                5  HANDLE EXTENDED DESCRIP. (2008)
  57. '                                6  USER'S TIME EXCEEDED (10553)
  58. '                                7  CARRIER DROPPED (10595)
  59. '
  60. ' PURPOSE -- To handle the RBBS-PC file system commands
  61. '
  62.       SUB FILESYS STATIC
  63.       FF = FILESYS.PARAMETER
  64.       FILESYS.PARAMETER = 1
  65.       ON FF GOSUB 20119, _  ' HANDLER TO LIST COMMENTS TO SYSOP
  66.                   20150, _  ' L)IST DIRECTORY COMMAND HANDLER
  67.                   20180, _  ' D)OWNLOAD COMMAND HANDLER
  68.                   20262, _  ' RETURN FROM EXTERNAL PROTOCOL'S
  69.                   20400, _  ' U)PLOAD COMMAND HANDLER
  70.                   21800, _  ' S)CAN DIRECTORY COMMAND HANDLER
  71.                   21850, _  ' P)ERSONAL FILES COMMAND HANDLER
  72.                   21860, _  ' N)EW FILES COMMAND HANDLER
  73.                   20705     ' RETURN FROM EXTENDED DESCRIPTIONS
  74.       GOTO 21920
  75. 20119 EC = 0
  76.       GOTO 20122
  77. '
  78. ' *****  SCAN DIRECTORIES (PRINT TEXT)  ****
  79. '
  80. '  (formerly lines 7000 to 7260 in RBBS-PC.BAS CPC16-1A
  81. 20120 A$ = CX$(2)+"Scanning"+CX$(3)+" Directory "+CX$(5) + _
  82.            FILE.NAME.HOLD$ +CX$(3)+ _
  83.            " for " +CX$(7)+ _
  84.            RS$
  85.       GOSUB 21650
  86.       IF FILESYS.PARAMETER > 1 THEN _
  87.          RETURN
  88.       PG = TRUE
  89. 20122 CALL OPENWORK (2,FILE.NAME$)
  90.       IF EC = 53 THEN _
  91.          CALL UPDTCALR ("Missing File " + FILE.NAME$,2) : _
  92.          A$ = "Missing file " + _
  93.               FILE.NAME$ + _
  94.               ". Please tell SYSOP" : _
  95.          GOSUB 21650 : _
  96.          RETURN
  97. 20124 CALL CARRIER
  98.       IF EOF(2) OR _
  99.          (SUBROUTINE.PARAMETER = -1 AND NOT LOCAL.USER) THEN _
  100.          GOTO 20142
  101. 20126 CALL READDIR (2,1)
  102.      IF EC <> 0 THEN _
  103.         EL = 20126 : _
  104.         GOTO 21900
  105.      IF CK = 0 THEN _
  106.         GOTO 20140
  107.      IF LEN(A$) > 0 THEN IF ASC(A$) = 32 THEN _
  108.         IF LAST.OK AND NOT EXTENDED.OFF THEN _
  109.            GOTO 20140 _
  110.         ELSE GOTO 20124
  111.      LAST.OK = FALSE
  112. 20128 IF CK > 1 THEN _
  113.          IF WILD.SEARCH THEN _
  114.             A = INSTR(A$," ") : _
  115.             IF A = 0 THEN _
  116.                GOTO 20124 _
  117.             ELSE Z$ = LEFT$(A$,A - 1) : _
  118.                  CALL WILDFILE (RS$,Z$,XXX) : _
  119.                  GOTO 20136_
  120.          ELSE Z$ = A$ : _
  121.               CALL ALLCAPS (Z$) : _
  122.               XXX = (INSTR(Z$,RS$) = 0) : _
  123.               GOTO 20136
  124. 20130 A = INSTR(9,MID$(A$,1,32),"/")
  125.       IF A = 0 THEN _
  126.          A = INSTR(9,MID$(A$,1,32),"-")
  127. 20132 IF A < 3 THEN _
  128.          GOTO 20124
  129.       IF INSTR("0123456789",MID$(A$,A - 1,1)) = 0 THEN _
  130.          GOTO 20124
  131.       A = A - 2
  132.       WK$ = RIGHT$(MID$(A$,A,8),2) + _
  133.             LEFT$(MID$(A$,A,8),2) + _
  134.             MID$(MID$(A$,A,8),4,2)
  135.       IF MID$(WK$,3,1) = " " THEN _
  136.          MID$(WK$,3,1) = "0"
  137.       IF MID$(WK$,5,1) = " " THEN _
  138.          MID$(WK$,5,1) = "0"
  139. 20134 XXX = (WK$ < RS$)
  140. 20136 IF XXX THEN _
  141.          GOTO 20124
  142.       IF PG THEN _
  143.          PG = FALSE : _
  144.          CALL OPENWORK (2,FILE.NAME$) : _
  145.          Q = 0 : _
  146.          GOTO 20124
  147. 20138 IF PG THEN _
  148.          GOTO 20124
  149. 20140 LAST.OK = TRUE
  150.       GOSUB 21650
  151.       IF FILESYS.PARAMETER > 1 THEN _
  152.          RETURN
  153.       CALL ASKMORE ("",TRUE,TRUE,ANS.INDEX,FALSE)                    ' KG081201
  154.       IF NO THEN _
  155.          EC = 0 : _
  156.          RETURN
  157.       IF NOT RET THEN _
  158.          GOTO 20124
  159. 20142 Q = 0
  160.       CLOSE 2
  161.       CALL CARRIER
  162.       IF SUBROUTINE.PARAMETER = -1 THEN _
  163.          FILESYS.PARAMETER = 7
  164.       RETURN
  165. '
  166. ' *  L - COMMAND FROM FILES MENU (LIST DIRECTORY)
  167. '
  168. 20150 LIST.DIRECTORY = TRUE
  169.       LIST.NEW = FALSE
  170.       SEARCH.DATE$ = ""
  171.       SEARCH.STRING$ = ""
  172.       SHOW.DIR.OF.DIR = NOT EXPERT.USER
  173.       CK = 0
  174.       IF Q > 1 THEN _
  175.          CALL ALLCAPS (B$(2)) : _
  176.          IF B$(2) = "L" THEN _
  177.             SHOW.DIR.OF.DIR = TRUE                                   ' KG081201
  178.       SEARCHING.ALL = FALSE                                          ' KG081201
  179. 20155 IF DOWNLOAD.COMPLETED AND AUTO.END = 1 THEN _
  180.         FILESYS.PARAMETER = 7: _
  181.         RETURN
  182.        IF LIST.NEW OR ANS.INDEX > 255 THEN _                          ' KG081201
  183.          RETURN                                                      ' KG081201
  184.       CALL GETDIRS (SHOW.DIR.OF.DIR)
  185.       IF Q = 0 THEN _
  186.          RETURN
  187.       SHOW.DIR.OF.DIR = FALSE
  188.       CALL CONVDIRS (ANS.INDEX)                                      ' KG081201
  189.       QX = LAST.INDEX                                                ' KG081201
  190. 20157 CALL CARRIER                                                   ' KG081201
  191.       IF SUBROUTINE.PARAMETER = -1 THEN _
  192.          FILESYS.PARAMETER = 7 : _
  193.          RETURN                                                      ' KG081201
  194.       GOTO 20161                                                     ' KG081201
  195. 20159 IF ANS.INDEX < LAST.INDEX THEN _                               ' KG081201
  196.          GOTO 20155                                                  ' KG081201
  197.       SEARCHING.ALL = FALSE                                          ' KG081201
  198.       CALL CSPUSHPOP (1)                                             ' KG082702
  199.       LAST.INDEX = 0                                                 ' KG082702
  200.       IF NO OR (FILE.NAME.HOLD$ = DIRECTORY.PREFIX$) THEN _
  201.          GOTO 20155                                                  ' KG081201
  202.       CALL QTPUT (EMPHASIZE.OFF$,0)
  203.       A$ = "End list.  R)elist, [Q]uit, or download what"
  204.       GOSUB 21668
  205.       CALL ALLCAPS (B$(1))
  206.       IF B$(1) = "R" THEN _
  207.          B$(ANS.INDEX) = A1$ : _                                     ' KG081201
  208.          GOTO 20161
  209.       IF LEN(B$(1)) > 1 AND _
  210.          USER.SECURITY.LEVEL >= OPT.SEC(19 - 20 * (MENU.INDEX = 6)) THEN _
  211.          ANS.INDEX = 1 : _                                           ' KG081201
  212.          GOSUB 20202                                                 ' KG082702
  213.       CALL CSPUSHPOP (2)                                             ' KG082702
  214.       RETURN                                                         ' KG082702
  215. 20161 IF INSTR(B$(ANS.INDEX),".") THEN _                             ' KG081201
  216.          GOTO 20172
  217.       VIOLATION$ = "List Dir. "
  218.       Z$ = B$(ANS.INDEX)                                             ' KG081201
  219.       A = INSTR("E+E-E",Z$)
  220.       IF A > 0 THEN _
  221.          IF A = 5 THEN _
  222.             EXTENDED.OFF = NOT EXTENDED.OFF : _
  223.             GOTO 20155 _                                             ' KG081201
  224.          ELSE EXTENDED.OFF = (A > 2) : _
  225.               GOTO 20155                                             ' KG081201
  226.       CALL ALLCAPS(Z$)
  227.       FILE.NAME.HOLD$ = Z$
  228.       A1$ = Z$
  229.       IF Z$ = DIRECTORY.PREFIX$ THEN _
  230.          GOTO 20164
  231.       IN.FMS = FALSE
  232. 20162 CALL CSPUSHPOP (1)         ' save dir list list processing     ' KG082702
  233.       CALL FMS (Z$,SEARCH.STRING$,SEARCH.DATE$,IN.FMS, _
  234.                 CATEGORY.NAME$(),CATEGORY.CODE$(),CATEGORY.DESC$(),_
  235.                 DOWNLOAD.FLAG,CAT.FOUND,ANS.INDEX)                   ' KG081201
  236.       WHILE DOWNLOAD.FLAG > 0 AND SUBROUTINE.PARAMETER > -1          ' KG081201
  237.          GOSUB 20202
  238.          IF FILESYS.PARAMETER > 1 THEN _
  239.             RETURN
  240.         IF DOWNLOAD.COMPLETED and AUTO.END = 1 THEN _
  241.            RETURN       ' AUTOLOGOFF MOD
  242.          X$ = CATEGORY.CODE$(CAT.FOUND)
  243.          CALL DISUPDIR (X$,SEARCH.STRING$,SEARCH.DATE$,DOWNLOAD.FLAG,ANS.INDEX) ' KG081201
  244.          CALL CHKTREMAIN (TIME.REMAINING!)
  245.          IF SUBROUTINE.PARAMETER = -1 THEN _
  246.             FILESYS.PARAMETER = 6 : _
  247.             RETURN
  248.          CALL CARRIER
  249.       WEND
  250.       IF SUBROUTINE.PARAMETER = -1 THEN _
  251.          FILESYS.PARAMETER = 7 : _
  252.          RETURN
  253.       IF ANS.INDEX > 255 THEN _                                      ' KG081201
  254.          LAST.INDEX = 0 : _                                          ' KG081201
  255.          RETURN                                                      ' KG081201
  256.       CALL CSPUSHPOP (2)        ' restore dir list list processing   ' KG082702
  257.       ACTIVE.FMS.DIRECTORY$ = ""
  258.       IF IN.FMS THEN _
  259.          GOTO 20159                                                  ' KG081201
  260.       IF USER.SECURITY.LEVEL < MIN.SEC.TO.VIEW THEN _
  261.          IF FILE.NAME.HOLD$ = UPLOAD.DIR.CHECK$ THEN _
  262.             FILE.NAME.HOLD$ = "of uploads" : _
  263.             GOTO 20172
  264.       FILE.NAME.HOLD$ = B$(ANS.INDEX)                                ' KG081201
  265.       IF LIMIT.SEARCH.TO.FMS THEN _
  266.          GOTO 20166
  267.       IF NOT SEARCHING.ALL THEN _                                    ' KG081201
  268.          IF FILE.NAME.HOLD$ = "ALL" OR FILE.NAME.HOLD$ = "A" THEN _  ' KG081201
  269.             SEARCHING.ALL = TRUE : _                                 ' KG083002
  270.             GOTO 21890                                               ' KG081201
  271.       CALL BADFILE (FILE.NAME.HOLD$,BAD.FILE.NAME.INDEX)
  272.       ON BAD.FILE.NAME.INDEX GOTO 20163,20172,20176
  273. 20163 FILE.NAME$ = FILE.NAME.HOLD$
  274.       CALL BADNAME (BAD.FILE.NAME.INDEX)
  275.       ON BAD.FILE.NAME.INDEX GOTO 20164,20176
  276. 20164 IF FILE.NAME$ = UPLOAD.DIR.CHECK$ AND _
  277.          USER.SECURITY.LEVEL >= MIN.SEC.TO.VIEW THEN _
  278.             FILE.NAME$ = UPLOAD.PATH$ _
  279.       ELSE FILE.NAME$ = DIRECTORY.PATH$
  280.       FILE.NAME$ = FILE.NAME$ + _
  281.                    FILE.NAME.HOLD$ + _
  282.                    "." + _
  283.                    DIRECTORY.EXTENTION$
  284.       CALL GRAPHIC (USER.GRAPHIC.DEFAULT$,FILE.NAME$)
  285. 20165 IF OK THEN _
  286.          CALL READDIR (2,1) : _
  287.          IF EC = 0 THEN _
  288.             IF LEFT$(A$,4) = "\FMS" THEN _
  289.                IN.FMS = TRUE : _
  290.                ACTIVE.FMS.DIRECTORY$ = FILE.NAME$ : _
  291.                GOTO 20162 _
  292.             ELSE GOTO 20167
  293. 20166 FILE.NAME$ = DIRECTORY.PATH$ + _
  294.                    FILE.NAME.HOLD$ + ".MNU"
  295.       CALL FINDIT (FILE.NAME$)
  296.       IF OK THEN _
  297.          CALL BUFFILE (FILE.NAME$,ANS.INDEX) : _                     ' KG081201
  298.          GOTO 20155                                                  ' KG081201
  299.       IF ALTDIR.EXTENSION$ = "" THEN _
  300.          GOTO 20172
  301.       FILE.NAME$ = DIRECTORY.PATH$ + _
  302.                    FILE.NAME.HOLD$ + _
  303.                    "." + _
  304.                    ALTDIR.EXTENSION$
  305.       CALL GRAPHIC (USER.GRAPHIC.DEFAULT$,FILE.NAME$)
  306.       IF NOT OK THEN _
  307.          GOTO 20172
  308. 20167 B$(0) = B$(ANS.INDEX)                                          ' KG081201
  309.       IF NOT LIST.NEW THEN _
  310.          GOTO 20168
  311.       GOSUB 20120
  312.       IF FILESYS.PARAMETER > 1 THEN _
  313.          RETURN
  314.       GOTO 20170
  315. 20168 CALL BUFFILE(FILE.NAME$,ANS.INDEX)                             ' KG081201
  316.       CALL CARRIER
  317.       IF SUBROUTINE.PARAMETER = -1 THEN _
  318.          FILESYS.PARAMETER = 7 : _
  319.          RETURN
  320. 20170 IF ANS.INDEX > 255 THEN _                                      ' KG081201
  321.          LAST.INDEX = 0 : _                                          ' KG081201
  322.          RETURN                                                      ' KG081201
  323.       B$(ANS.INDEX) = B$(0)                                          ' KG081201
  324.       GOTO 20159                                                     ' KG081201
  325. 20172 IF NOT SEARCHING.ALL THEN _
  326.          A$ = "Directory " + _
  327.               FILE.NAME.HOLD$ + _
  328.               " not found!" : _
  329.          GOSUB 21640 : _
  330.          NO = TRUE : _
  331.          IF FILESYS.PARAMETER > 1 THEN _
  332.             RETURN
  333.       GOTO 20155                                                     ' KG081201
  334. 20176 CALL SVIOLATION
  335.       IF DENY.ACCESS THEN _
  336.          FILESYS.PARAMETER = 4 : _
  337.          RETURN
  338.       GOTO 20172
  339. '
  340. ' *  D - COMMAND FROM FILES MENU (SEARCH FOR FILE TO DOWNLOAD)
  341. '
  342. 20180 A$ = CX$(1) +"DeFault Extension is "+CX$(2) + DEFAULT.EXTENSION$ + CRLF$
  343.  A$ = A$ + CX$(5)+"Download"+CX$(6)+" what file(s)"+CX$(7)
  344.       GOSUB 21668                                                    ' KG081201
  345.       IF FILESYS.PARAMETER > 1 THEN _
  346.          RETURN
  347.       IF Q = 0 THEN _
  348.          RETURN
  349. 20202 IF (TIME.LOCK AND 2) AND (NOT TIME.LOCK.EXEMPT) AND NOT HAS.PRIVDOOR THEN _ ' KG052501
  350.          CALL TIMELOCK : _
  351.          IF NOT OK THEN _
  352.             RETURN
  353.       LAST.DOWNLOAD = LAST.INDEX                                     ' KG081201
  354.       FIRST.DOWNLOAD = ANS.INDEX                                     ' KG081201
  355.       COMMAND.TRANSFER$ = ""
  356. '      IF AUTODOWNLOAD.AVAILABLE THEN _
  357. '         COMMAND.TRANSFER$ = "X"
  358. '      AUTODOWNLOAD.IN.PROGRESS = AUTODOWNLOAD.AVAILABLE
  359.       IF LAST.DOWNLOAD > FIRST.DOWNLOAD THEN _
  360.          Z$ = B$(LAST.DOWNLOAD) : _
  361.          CALL ALLCAPS(Z$) : _
  362.          IF LEN (Z$) = 1 AND INSTR(DFLTXFER$,Z$) > 0 THEN _
  363.             LAST.DOWNLOAD = LAST.DOWNLOAD - 1 : _
  364.             COMMAND.TRANSFER$ = Z$ : _
  365.             AUTODOWNLOAD.IN.PROGRESS = FALSE : _
  366.             IF MID$(INTERNAL.EQUIV$,INSTR(DFLTXFER$,Z$),1) = "N" THEN _
  367.                COMMAND.TRANSFER$ = ""
  368.       BATCH.BYTES# = 0
  369.       BATCH.BLOCKS# = 0
  370.       CALL KILLWORK (NODE.WORK.FILE$)
  371.       EC = 0
  372.       FOR ANS.INDEX = FIRST.DOWNLOAD TO LAST.DOWNLOAD                ' KG081201
  373.          GOSUB 20205
  374.          COMMAND.TRANSFER$ = FT$                                     ' KG082301
  375.          CALL LINE25                                                 ' KG082703
  376.          IF FILESYS.PARAMETER > 1 THEN _
  377.             ANS.INDEX = LAST.DOWNLOAD + 1                            ' KG081201
  378. 20203 NEXT
  379.       LAST.INDEX = 0                                                 ' KG082702
  380.       IF FILESYS.PARAMETER > 1 THEN _
  381.          RETURN
  382.       BATCH.TRANSFER = FALSE
  383.       COMMAND.TRANSFER$ = ""
  384.       RETURN
  385. 20205 MARK.TIME = (ANS.INDEX = FIRST.DOWNLOAD OR NOT CONCAT.FILES)   ' KG081201
  386.       FILE.NAME$ = B$(ANS.INDEX)                                     ' KG081201
  387.       VIOLATION$ = "Download "
  388.       IF PERSONAL.DOWNLOAD THEN _
  389.          CALL BRKFNAME (FILE.NAME$,DR$,Y$,X$,TRUE) : _
  390.          FILE.NAME.HOLD$ = Y$ + _
  391.                            X$ : _
  392.          GOTO 20235
  393. '************************************************************
  394. ' Mods to default to ZIP extension if extension = null
  395. ' or No extension if "." = the last charater  Pe 09/22/89
  396. '
  397.   L = LEN(FILE.NAME$)
  398.   X = INSTR(FILE.NAME$ + ".",".")
  399.    IF X = L THEN _
  400.      FILE.NAME$ = LEFT$(FILE.NAME$,L-1) : _
  401. GOTO 20215
  402. '
  403.  CALL BRKFNAME (FILE.NAME$,DR$,Y$,X$,TRUE)
  404.   FILE.NAME.HOLD$ = Y$ + _
  405.                     X$
  406.  IF X$ = "" THEN _
  407.    X$ = "."+DEFAULT.EXTENSION$ : _
  408.   FILE.NAME$ = FILE.NAME$ + X$
  409. '
  410. ' end of mods 
  411. '******************************************
  412. ' added new line number below  pe 09/22/89
  413. '
  414. 20215 FILE.NAME.HOLD$ = FILE.NAME$
  415.       CALL BADFILE (FILE.NAME$,BAD.FILE.NAME.INDEX)
  416.       ON BAD.FILE.NAME.INDEX GOTO 20220,20231,20233
  417. 20220 CALL ROTORSDIR (FILE.NAME$,SUBDIR$(),SUBDIR.COUNT + _
  418.                       ((USER.SECURITY.LEVEL < MIN.SEC.TO.VIEW) OR _
  419.                        NOT CAN.DOWNLOAD.FROM.UP),MARK.TIME)
  420. 20225 IF OK THEN _
  421.          GOTO 20235
  422. 20231 A$ = FILE.NAME.HOLD$ + _
  423.            " not found!"
  424.       CALL UPDTCALR (A$,2)
  425.       AUTO.LOGOFF = FALSE
  426. '      IF AUTODOWNLOAD.IN.PROGRESS THEN _
  427. '         A$ = A$ + _
  428. '              " during AUTODOWNLOAD" : _
  429. '         GOSUB 21640 : _
  430. '         RETURN
  431.       A$ = A$ + _
  432.            " Correct name"+PRESS.ENTER.EXPERT$
  433.       GOSUB 21660
  434.       IF FILESYS.PARAMETER > 1 THEN _
  435.          RETURN
  436.       IF Q=0 THEN _
  437.          RETURN
  438.       B$(ANS.INDEX) = B$(1)                                          ' KG081201
  439.       GOTO 20205
  440. 20233 CALL SVIOLATION
  441.       IF DENY.ACCESS THEN _
  442.          FILESYS.PARAMETER = 4 : _
  443.          RETURN
  444.       GOTO 20231
  445. 20235 CALL BADNAME (BAD.FILE.NAME.INDEX)
  446.       ON BAD.FILE.NAME.INDEX GOTO  20236,20245
  447. 20236 LINE.25$ = "(D) " + _
  448.                  Z$
  449. '      IF AUTODOWNLOAD.IN.PROGRESS THEN _
  450. '         MID$(LINE.25$,2,1) = "A"
  451. '
  452. ' *  TEST FOR DOWNLOAD SECURITY
  453. '
  454.       CALL OPENWORK (2,FILESEC.FILE$)
  455.       IF EC = 53 THEN _
  456.          CALL UPDTCALR ("Missing file " + FILESEC.FILE$,2) : _
  457.          GOTO 20247
  458. 20242 IF EOF(2) THEN _
  459.          GOTO 20247
  460.       CALL READPARMS (WORK.ARA$(),3,1)
  461.       IF EC <> 0 THEN _
  462.          EL = 20242 : _
  463.          GOTO 21900
  464. 20243 CALL WILDFILE (WORK.ARA$(1),Z$,OK)
  465.       IF NOT OK THEN _
  466.          GOTO 20242
  467. 20244 IF USER.SECURITY.LEVEL < VAL(WORK.ARA$(2)) THEN _
  468.          GOTO 20245
  469.       FILE.PASSWORD$ = WORK.ARA$(3)
  470.       IF FILE.PASSWORD$ = "" THEN _
  471.          GOTO 20247
  472.       CALL ALLCAPS (FILE.PASSWORD$)
  473.       IF FILE.PASSWORD$ = PASSWORD$ THEN _
  474.          GOTO 20247
  475.       A$ = "Enter PASSWORD to download " + _
  476.            FILE.NAME$
  477.       GOSUB 21660
  478.       IF FILESYS.PARAMETER > 1 THEN _
  479.          RETURN
  480.       IF Q = 0 THEN _
  481.          RETURN
  482.       CALL ALLCAPS (B$(1))
  483.       IF B$(1) = FILE.PASSWORD$ THEN _
  484.          GOTO 20247
  485. 20245 VIOLATION$ = "DownLoad " + _
  486.                    FILE.NAME$
  487. 20246 CALL SVIOLATION
  488.       IF DENY.ACCESS THEN _
  489.          FILESYS.PARAMETER = 4
  490.       RETURN
  491. 20247 DF = 0
  492.       CALL BRKFNAME (FILE.NAME$,DR$,X$,EXTENTION$,FALSE)
  493. '      IF AUTODOWNLOAD.IN.PROGRESS THEN _
  494. '         A$ = "Transferring -- " + _
  495. '              B$(ANS.INDEX) : _                                      ' KG081201
  496. '         GOSUB 21640 : _
  497. '         IF FILESYS.PARAMETER > 1 THEN _
  498. '            RETURN
  499.       IF INSTR("...WRK.FW .ARC.EXE.COM.OBJ.WKS.LBR.ZIP.PAK.ZOO.LZH.","."+EXTENTION$+".") > 2 OR _ ' KG081601
  500.          MID$(EXTENTION$,2,1) = "Q" OR _
  501.          (REQUIRE.NON.ASCII AND EXTENTION$ = "BAS") THEN _
  502.             DF = TRUE                                                ' KG081201
  503. 20248 A$ = ""
  504.       IF BATCH.TRANSFER THEN _
  505.          IF ANS.INDEX < LAST.DOWNLOAD THEN _                         ' KG081201
  506.             GOTO 20260
  507.       CALL XFERTYPE (2,TRUE)
  508.       IF FF THEN _
  509.          GOTO 20260
  510.       CALL XFERTYPE (1,TRUE)
  511.       IF SUBROUTINE.PARAMETER = -1 THEN _
  512.          FILESYS.PARAMETER = 7 : _                                   ' KG081201
  513.          RETURN
  514. 20260 TRANSFER.FUNCTION = 1
  515.       GOSUB 21790
  516.       IF FILESYS.PARAMETER > 1 THEN _
  517.          RETURN
  518. BATCH.TRANSFER = BATCH.PROTO    'Pe Batch Mod
  519. '      BATCH.TRANSFER = (BATCH.PROTO AND (LAST.DOWNLOAD > FIRST.DOWNLOAD))
  520.       IF BATCH.TRANSFER AND COMMAND.TRANSFER$ = "" THEN _
  521.          COMMAND.TRANSFER$ = FT$
  522.       ON INSTR("AXCYN",INTERNAL.PROTO$) GOTO _
  523.          20340, _              ' ASCII DOWNLOAD
  524.          20290, _              ' XMODEM
  525.          20290, _              ' XMODEM CRC
  526.          20270, _              ' YMODEM
  527.          21700                 ' NONE - CANCEL
  528. '
  529. ' *  EXTERNAL PROTOCOL DOWNLOADS/UPLOADS
  530. '
  531. 20261 IF REQ.8.BIT THEN _
  532.          IF NOT EIGHT.BIT THEN _
  533.             GOSUB 20318 : _
  534.             IF FILESYS.PARAMETER > 1 THEN _
  535.                RETURN _
  536.             ELSE GOSUB 20992 : _
  537.                  IF FILESYS.PARAMETER > 1 THEN _
  538.                     RETURN
  539.       IF TRANSFER.FUNCTION = 1 THEN _
  540.          GOSUB 20750 : _
  541.          CLOSE 2 : _
  542.          IF FILESYS.PARAMETER > 1 OR NOT OK THEN _
  543.             RETURN
  544.       IF BATCH.TRANSFER THEN _
  545.          IF ANS.INDEX < LAST.DOWNLOAD THEN _                         ' KG081201
  546.             RETURN _
  547.          ELSE BLOCKS.IN.FILE# = BATCH.BLOCKS# : _
  548.               BYTES.IN.FILE# = BATCH.BYTES# : _
  549.               NUM.DNLD.BYTS! = BATCH.BYTES# : _
  550.               IF BYTES.IN.FILE# < 1 THEN _                           ' KG082507
  551.                  RETURN _                                            ' KG082507
  552.               ELSE GOSUB 20780 : _                                   ' KG082507
  553.                    IF FILESYS.PARAMETER > 1 OR NOT OK THEN _         ' KG082507
  554.                       RETURN                                         ' KG082507
  555. '      IF AUTODOWNLOAD.IN.PROGRESS THEN _
  556. '         CALL SENDNAME
  557.          IF ABORT THEN _
  558.             DOWNLOAD.COMPLETED = FALSE : _
  559.             GOSUB 21760 : _
  560.             RETURN
  561.       CALL TRANSFER
  562. 20262 IF PRIVATE.DOOR THEN _
  563.          COMMAND.TRANSFER$ = FT$ : _
  564.          CALL XFERTYPE (2,TRUE) : _
  565.          COMMAND.TRANSFER$ = ""
  566.       CALL OPENWORK (2,"XFER-" + NODE.ID$ + ".DEF")
  567.       IF EC <> 0 THEN _
  568.          GOTO 20267
  569.       CALL READPARMS (WORK.ARA$(), FAILURE.PARM, 1)
  570.       IF EC <> 0 THEN _
  571.          GOTO 20267
  572.       CALL KILLWORK ("XFER-" + NODE.ID$ + ".DEF")
  573. 20264 IF PRIVATE.DOOR THEN _
  574.          FILE.NAME$ = WORK.ARA$(1) : _
  575.          CALL BRKFNAME (FILE.NAME$,X$,FILE.NAME.HOLD$,Y$,TRUE) : _
  576.          FILE.NAME.HOLD$ = FILE.NAME.HOLD$ + _
  577.                            Y$ : _
  578.          SIZE.ONLY = TRUE : _
  579.          CALL OPENWORK (2,FILE.NAME$) : _
  580.          GOSUB 20760 : _
  581.          IF FILESYS.PARAMETER > 1 OR NOT OK THEN _
  582.             RETURN
  583.          IF LEFT$(WORK.ARA$(FAILURE.PARM),1) = "L" THEN _
  584.             MID$(WORK.ARA$(FAILURE.PARM),1,1) = FAILURE.STRING$
  585. 20265 IF TRANSFER.FUNCTION = 2 THEN _
  586.          IF INSTR(WORK.ARA$(FAILURE.PARM),FAILURE.STRING$) <> 1 THEN _
  587.             GOTO 20700 _
  588.          ELSE GOTO 20730
  589.       IF TRANSFER.FUNCTION = 1 THEN _
  590.          DOWNLOAD.COMPLETED = (INSTR(WORK.ARA$(FAILURE.PARM),FAILURE.STRING$) <> 1)
  591.       GOSUB 21760
  592.       CALL CARRIER
  593.       IF SUBROUTINE.PARAMETER = -1 THEN _
  594.          FILESYS.PARAMETER = 7
  595.       RETURN
  596. '
  597. ' *  XFER FILE NOT FOUND
  598. '
  599. 20267 EL = 20262
  600.       GOTO 21900
  601.  
  602. '
  603. ' *  YMODEM DOWNLOAD DRIVER
  604. '
  605. 20270 GOTO 20292
  606. '
  607. ' *  XMODEM DOWNLOAD DRIVER
  608. '
  609. 20290 '
  610. 20292 GOSUB 20750
  611.       IF FILESYS.PARAMETER > 1 OR NOT OK THEN _
  612.          RETURN
  613.       A1$ = "SEND"
  614.       GOSUB 20320
  615.       IF FILESYS.PARAMETER > 1 THEN _
  616.          RETURN
  617.       IF LOCAL.USER THEN _
  618.          CALL QTPUT1 ("Protocol not available in local mode") : _
  619.          RETURN
  620. '      IF AUTODOWNLOAD.IN.PROGRESS THEN _
  621. '         GOSUB 20294
  622.          IF ABORT THEN _
  623.             RETURN
  624.       GOSUB 21300
  625.       IF FILESYS.PARAMETER > 1 THEN _
  626.          RETURN
  627.       A$ = ""
  628.       GOTO 20390
  629. 20294 CALL SENDNAME
  630.       RETURN
  631. 20318 A$ = "Please SWITCH to N,8,1 for binary transfer"
  632.       GOSUB 21630
  633.       IF FILESYS.PARAMETER > 1 THEN _
  634.          RETURN
  635.       CALL DELAYIT (3)
  636.       RETURN
  637. 20320 IF NOT EIGHT.BIT THEN _
  638.          GOSUB 20318 : _
  639.          IF FILESYS.PARAMETER > 1 THEN _
  640.             RETURN
  641. 20325 IF CHECKSUM THEN _
  642.          NEGATIVE.ACKNOWLEDGE$ = CHR$(21) : _
  643.          SOL = 132 _
  644.       ELSE NEGATIVE.ACKNOWLEDGE$ = "C" : _
  645.            SOL = 133
  646. 20330 'IF AUTODOWNLOAD.IN.PROGRESS THEN _
  647.       '   RETURN
  648.       A$ = PROTO.PROMPT$ + _
  649.             " " + A1$ + _
  650.             " of " + _
  651.             FILE.NAME.HOLD$ + _
  652.             " ready.  <Ctrl X> aborts"
  653.       GOSUB 21650
  654. '      IF A1$ = "SEND" THEN _
  655. '         CALL TALK (8,A$) _
  656. '      ELSE CALL TALK (9,A$)
  657.       RETURN
  658. '
  659. ' *  ASCII DOWNLOAD DRIVER
  660. '
  661. 20340 IF DF THEN _
  662.          A$ = "Switch to a non-ascii protocol" : _
  663.          GOSUB 21650 : _
  664.          GOTO 21700
  665.       GOSUB 20750
  666.       IF FILESYS.PARAMETER > 1 OR NOT OK THEN _
  667.          RETURN
  668.       CALL OPENWORK (2,FILE.NAME$)
  669.       IF (ANS.INDEX = FIRST.DOWNLOAD OR NOT CONCAT.FILES) THEN _     ' KG081201
  670.          A$ = "^X aborts.  ^S suspends ^Q resumes" : _
  671.          GOSUB 21640 : _
  672.          IF FILESYS.PARAMETER > 1 THEN _
  673.             RETURN _
  674.          ELSE A$ = PROTO.PROMPT$ + " SEND of " + _
  675.               FILE.NAME.HOLD$ + _
  676.               " ready. Press Any Key to start" : _
  677.          TURBO.KEY = 2 : _
  678.          FORCE.KEYBOARD = TRUE : _                                   ' KG090101
  679.          GOSUB 21660 : _
  680.          IF FILESYS.PARAMETER > 1 THEN _
  681.             RETURN
  682. 20380 STOP.INTERRUPTS = FALSE
  683.       TU = 0
  684.       SWAP TU,PAGE.LENGTH
  685.       CALL BUFFILE (FILE.NAME$,X)
  686.       SWAP TU,PAGE.LENGTH
  687.       NON.STOP = (PAGE.LENGTH < 1)
  688.       IF STOP.FILE THEN _
  689.          DOWNLOAD.COMPLETED = FALSE : _
  690.          GOTO 20390
  691. 20381 IF (ANS.INDEX = LAST.DOWNLOAD OR NOT CONCAT.FILES) THEN _      ' KG081201
  692.          CALL QTPUT (CHR$(26),0) : _
  693.          IF NOT LOCAL.USER AND SUBROUTINE.PARAMETER = 0 THEN _
  694.             FOR X = 1 TO 5 : _
  695.                CALL PUTCOM (CHR$(7)) : _
  696.                CALL DELAYIT (3) : _
  697.             NEXT
  698. 20385 DOWNLOAD.COMPLETED = TRUE
  699. 20390 GOTO 21760
  700. '
  701. ' *  U - COMMAND FROM FILES MENU (UPLOAD)
  702. '
  703. 20395 GOSUB 21640
  704.       IF FILESYS.PARAMETER > 1 THEN _
  705.          RETURN
  706.       A$ = "Correct name of file to upload" + _
  707.            PRESS.ENTER.EXPERT$
  708.       GOSUB 21660
  709.       IF FILESYS.PARAMETER > 1 THEN _
  710.          RETURN
  711.       IF Q = 0 THEN _
  712.          RETURN
  713.       B$(ANS.INDEX) = B$(1)
  714.       GOTO 20435
  715. 20400 CALL TIMEBACK (1)                                              ' KG082701
  716.       GOSUB 20420                                                    ' KG081201
  717.       FIRST.UPLOAD = ANS.INDEX                                       ' KG081201
  718.       GOTO 20430
  719. 20420 A$ = "Upload what file(s)"                                     ' KG081201
  720.       GOSUB 21668                                                    ' KG081201
  721.       RETURN
  722. '
  723. ' *  SEARCH FOR DUPLICATE FILENAME
  724. '
  725. 20430 Z$ = B$(LAST.INDEX)                                            ' KG081201
  726.       IF LEN(Z$) = 1 THEN _
  727.          CALL ALLCAPS (Z$) : _
  728.          IF INSTR(DFLTXFER$,Z$) > 0 THEN _
  729.             LAST.INDEX = LAST.INDEX - 1 : _                          ' KG081201
  730.             COMMAND.TRANSFER$ = Z$
  731.       FOR ANS.INDEX = FIRST.UPLOAD TO LAST.INDEX                     ' KG081201
  732.          GOSUB 20435
  733.          IF FILESYS.PARAMETER > 1 THEN _
  734.             ANS.INDEX = LAST.INDEX + 1                               ' KG081201
  735.       NEXT
  736.       COMMAND.TRANSFER$ = ""
  737.       RETURN
  738. 20435 FILE.NAME.HOLD$ = B$(ANS.INDEX)
  739.       CALL ALLCAPS(FILE.NAME.HOLD$)
  740.       FILE.NAME$ = FILE.NAME.HOLD$
  741.       VIOLATION$ = "Upload "
  742. '      IF INSTR(FILE.NAME$,":") OR _
  743. '         INSTR(FILE.NAME$,"\") OR _
  744. '         INSTR(FILE.NAME$," ") OR _       'Pe 06/06/89
  745. '         INSTR(FILE.NAME$,"*") OR _  
  746. '         INSTR(FILE.NAME$,"?") OR _     'Pe 06/06/89
  747. '         INSTR(FILE.NAME$,"/") THEN _
  748. '         GOTO 20451
  749.       CALL NOPATH (FILE.NAME$,BAD.FILE.NAME.INDEX)                   ' KG060801
  750.       IF BAD.FILE.NAME.INDEX THEN _                                  ' KG060801
  751.          GOTO 20451                                                  ' KG060801
  752.       CALL BADFILE (FILE.NAME$,BAD.FILE.NAME.INDEX)
  753. 'comment out the NEXT 2 lines if you want to enable files without EXTENSION
  754. 'to regular users
  755. '
  756. IF EXT$ = "" AND USER.SECURITY.LEVEL < OVERWRITE.SECURITY.LEVEL THEN _
  757.        GOTO 20451       'Pe 12/22/88
  758. '
  759.       ON BAD.FILE.NAME.INDEX GOTO 20440,20451,20515
  760. 20440 TMP.FILE.NAME$ ="NOTHANX.DEF"               'PE mode
  761.       CALL FINDIT (TMP.FILE.NAME$)                                'DGS-UNW
  762.       IF OK THEN                                                  'DGS-UNW
  763.        CALL QTPUT ("Checking off line file list....",1)           'Pe 02/11/89
  764.      OPEN TMP.FILE.NAME$ FOR INPUT AS #9                      'DGS-UNW
  765.      HAV.FILE$ = ""                                           'DGS-UNW
  766.      FILE.IN.LIST = FALSE                                     'DGS-UNW
  767.      WHILE NOT EOF(9) AND NOT FILE.IN.LIST                    'DGS-UNW
  768.         INPUT #9, HAV.FILE$                                   'DGS-UNW
  769.         CALL ALLCAPS (HAV.FILE$)                              'DGS-UNW
  770.         FILE.IN.LIST = (INSTR(FILE.NAME.HOLD$,HAV.FILE$) > 0) 'DGS-UNW
  771.      WEND                                                     'DGS-UNW
  772.      CLOSE 9                                                  'DGS-UNW
  773.       END IF                                                      'DGS-UNW
  774.       IF FILE.IN.LIST THEN _                                      'DGS-UNW
  775.       CALL BUFFILE ("NOTHANX.MSG",X) : _         'Pe 02/19/89
  776.      GOTO 20453                                               'DGS-UNW
  777.        CALL ROTORSDIR (FILE.NAME$,SUBDIR$(),SUBDIR.COUNT,TRUE)
  778. 20450 IF OK THEN _
  779.          GOTO 20452
  780.       CLOSE 2                                                        ' MC0220
  781.       OPEN "EXTCHECK.DEF" FOR INPUT AS #2                            ' MC0220
  782.       DO WHILE NOT EOF(2)                                            ' MC0220
  783.        INPUT #2, CHECK$                                          ' MC0220
  784.       IF INSTR(FILE.NAME$,".") AND _                                 ' MC0220
  785.      RIGHT$(FILE.NAME.HOLD$,3) <> CHECK$ THEN _                  ' MC0220
  786.      FILE.NAME$ = LEFT$(FILE.NAME.HOLD$,LEN(FILE.NAME.HOLD$)-3) + _
  787.      CHECK$ : _                                                  ' MC0220
  788.      CALL ROTORSDIR (FILE.NAME$,SUBDIR$(),SUBDIR.COUNT,TRUE)     ' MC0220
  789.       IF OK THEN _                                                   ' MC0220
  790.      GOTO 20452                                                  ' MC0220
  791.        LOOP                                                          ' MC0220
  792.        CLOSE 2                                                       ' MC0220
  793.       GOTO 20475
  794.       CALL BRKFNAME (FILE.NAME$,DR$,X$,EXTENTION$,FALSE)
  795.       IF EXTENTION$ = DEFAULT.EXTENSION$ THEN _
  796.          GOTO 20475
  797.       X$ = X$ + "." + DEFAULT.EXTENSION$
  798.       CALL ROTORSDIR (X$,SUBDIR$(),SUBDIR.COUNT,FALSE)
  799.       IF OK THEN _
  800.          FILE.NAME.HOLD$ = DEFAULT.EXTENSION$ + " ver of " + FILE.NAME.HOLD$ : _
  801.          GOTO 20454
  802.       GOTO 20475
  803.  20451 A$ = "Invalid file name. File name cannot contain a Drive letter"+CRLF$ +_
  804.            "Subdirectory name, a Space, or any WildCard Characters "
  805.       GOSUB 21655
  806.       CALL DELAYIT (2)
  807.       FILESYS.PARAMETER = 3
  808.       RETURN
  809. 20452 IF USER.SECURITY.LEVEL < OVERWRITE.SECURITY.LEVEL THEN _
  810.          GOTO 20453
  811.       A$ = "Overwrite file (Y,[N])"
  812.       GOSUB 21660
  813.       IF FILESYS.PARAMETER > 1 THEN _
  814.          RETURN
  815.       IF NOT YES THEN _
  816.          GOTO 20453
  817.       Z$ = FILE.NAME$
  818.       CALL KILLWORK (FILE.NAME$)
  819.       IF EC <> 0 THEN _
  820.          EL = 20452 : _
  821.          GOTO 21900
  822.       GOTO 20475
  823. 20453 CLOSE 2
  824.       IF USER.SECURITY.LEVEL >= ADD.DIR.SECURITY THEN _
  825.          GOTO 20455
  826. 20454 CALL QTPUT1 ("Thanks, but we already have " + FILE.NAME.HOLD$)
  827.       CALL UPDTCALR ("Upload duplicate " + FILE.NAME.HOLD$,1)
  828.       RETURN
  829. 20455 A$ = "Add new directory entry (Y,[N])"
  830.       TURBO.KEY = - TURBO.KEY.USER
  831.       GOSUB 21660
  832.       IF FILESYS.PARAMETER > 1 THEN _
  833.          RETURN
  834.       IF NOT YES THEN _
  835.          RETURN
  836.       ADDING.DESC.ONLY = TRUE
  837.       FT$ = "l"
  838. CALL UPDTUPLOAD (CATEGORY.NAME$(),CATEGORY.CODE$(),LINES.IN.MESSAGE,1) 'UPL-MOD
  839.       GOSUB 20702
  840.       RETURN
  841. 20475 FILE.NAME$ = LEFT$(FILE.NAME$,LEN(FILE.NAME$)-3) + _           'MC0220
  842.       RIGHT$(FILE.NAME.HOLD$,3)                                      'MC0220
  843.       Z$ = UPLOAD.DRIVE.FILE$
  844.       CALL FINDFREE
  845.       IF VAL(FREE.SPACE$) < 4096 THEN _
  846.          CALL QTPUT1 ("No room for uploads.  Try tomorrow.") : _
  847.          ANS.INDEX = LAST.INDEX + 1 : _                              ' KG081201
  848.          RETURN
  849.       A$ = "Upload disk has" + _
  850.            FREE.SPACE$
  851.       GOSUB 21640
  852.       IF FILESYS.PARAMETER > 1 THEN _
  853.          RETURN
  854. '*****************
  855. CALL UPDTUPLOAD (CATEGORY.NAME$(),CATEGORY.CODE$(),LINES.IN.MESSAGE,1)  '<++++++
  856. '*****************
  857. IF ABORT THEN _     'PE 12/14/88
  858. ABORT = FALSE : _   'PE 12/14/88
  859.  RETURN
  860.       LINE.25$ = "(U) " + _
  861.                  FILE.NAME.HOLD$
  862.       SUBROUTINE.PARAMETER = 2
  863.       CALL LINE25
  864.       A$ = ""
  865.       OK = TRUE
  866. 20477 CALL XFERTYPE (2,TRUE)
  867.       IF FF THEN _
  868.          GOTO 20500
  869.       CALL XFERTYPE (1,TRUE)
  870.       IF SUBROUTINE.PARAMETER = -1 THEN _
  871.          FILESYS.PARAMETER = 7 : _                                   ' KG081201
  872.          RETURN
  873. 20500 CALL AUTOLOGOFF       'Autologoff mod
  874.      TRANSFER.FUNCTION = 2
  875.       AUTODOWNLOAD.IN.PROGRESS = FALSE
  876.       GOSUB 21790
  877.       IF FILESYS.PARAMETER > 1 THEN _
  878.          RETURN
  879.       ON INSTR("AXCYN",INTERNAL.PROTO$) GOTO _
  880.          20560, _         ' ASCII UPLOAD
  881.          20542, _         ' XMODEM
  882.          20542, _         ' XMODEM CRC
  883.          20542, _         ' YMODEM
  884.          20735            ' NONE - CANCEL
  885.       GOTO 20261
  886. 20510 D$ = "<Esc> by SYSOP aborts"
  887.       GOSUB 21710
  888.       RETURN
  889. 20515 CALL SVIOLATION
  890.       IF DENY.ACCESS THEN _
  891.          FILESYS.PARAMETER = 4 : _
  892.          RETURN
  893.       GOTO 20420
  894. '
  895. ' *  XMODEM/YMODEM UPLOAD DRIVER
  896. '
  897. 20542 A1$ = "RECEIVE"
  898.       GOSUB 20320
  899.       IF FILESYS.PARAMETER > 1 THEN _
  900.          RETURN
  901.       OK = TRUE
  902.       GOSUB 20860
  903.       IF FILESYS.PARAMETER > 1 THEN _
  904.          RETURN
  905.       IF OK THEN _
  906.          GOTO 20700
  907.       GOTO 20730
  908. '
  909. ' *  ASCII UPLOAD
  910. '
  911. 20560 LINE.ACK = (DEFAULT.LINE.ACK$ <> "")
  912.       IF LINE.ACK THEN _
  913.          A$ = "Acknowledge each line ([Y],N)" : _
  914.          TURBO.KEY = - TURBO.KEY.USER : _
  915.          LINE.ACK = NOT NO : _
  916.          GOSUB 21660 : _
  917.          IF FILESYS.PARAMETER > 1 THEN _
  918.             RETURN
  919.       CALL QTPUT1 ("Transfer MUST end with a <Ctrl-K>")
  920.       CALL QTPUT1 (PROTO.PROMPT$+" RECEIVE of " + FILE.NAME.HOLD$ + " ready")
  921.       OK = FALSE
  922.       XOFF = FALSE
  923.       CALL OPENOUTW(FILE.NAME$)
  924.       IF EC <> 0 AND EC <> 53 THEN _
  925.          EL = 20560 : _
  926.          GOTO 21900
  927.       GOSUB 20510
  928.       IF FILESYS.PARAMETER > 1 THEN _
  929.          RETURN
  930. 20600 CALL EOFCOMM (CHAR%)
  931.       WHILE CHAR% <> -1
  932.          CALL CARRIER
  933.          IF SUBROUTINE.PARAMETER = -1 THEN _
  934.             FILESYS.PARAMETER = 7 : _
  935.             RETURN
  936.          IF NOT FOSSIL THEN _
  937.             IF LOF(3) < 512 THEN _
  938.                CALL PUTCOM(XOFF$) : _
  939.                XOFF = TRUE
  940. 20610    CALL FLUSHCOM (X$)
  941.          IF SUBROUTINE.PARAMETER = -1 THEN _
  942.             FILESYS.PARAMETER = 7 : _                                   ' KG081201
  943.             RETURN
  944.          IF INSTR(X$,CHR$(11)) THEN _
  945.             GOTO 20650
  946.          OK = TRUE
  947. 20620    CALL PRINTWRK (X$)
  948.          IF LINE.ACK THEN _
  949.             IF INSTR(X$,CHR$(10)) > 0 THEN _
  950.                CALL PUTCOM (DEFAULT.LINE.ACK$)
  951.          IF EC <> 0 THEN _
  952.             EL = 20620 : _
  953.             GOTO 21900
  954.          D$ = X$
  955.          NUM.RETURNS = 0
  956.          GOSUB 21720
  957.          IF FILESYS.PARAMETER > 1 THEN _
  958.             RETURN
  959. 20621    CALL FINDFUNC
  960.          IF SUBROUTINE.PARAMETER < 0 THEN _
  961.             FILESYS.PARAMETER = 2 : _
  962.             RETURN
  963.          IF KEY.PRESSED$ = ESCAPE$ THEN _
  964.             GOTO 20745
  965.          IF NOT OK THEN _
  966.             GOTO 20670
  967.       CALL EOFCOMM (CHAR%)
  968. 20630 WEND
  969.       CALL CARRIER
  970.       IF SUBROUTINE.PARAMETER = -1 THEN _
  971.          FILESYS.PARAMETER = 7 : _
  972.          RETURN
  973.       IF XOFF THEN _
  974.          XOFF = FALSE : _
  975.          CALL PUTCOM (XON$) : _
  976.          IF EC <> 0 THEN _
  977.             EL = 20630 : _
  978.             GOTO 21900
  979.       GOTO 20600
  980. 20650 X = INSTR(X$,CHR$(11))
  981.       IF X = 1 THEN _
  982.          IF NOT OK THEN _
  983.             GOTO 20730 _
  984.          ELSE GOTO 20700
  985.       CALL PRNTWRKA (LEFT$(X$,X-1))
  986.       IF EC <> 0 THEN _
  987.          EL = 20650 : _
  988.          GOTO 21900
  989.       GOTO 20700
  990. 20670 A$ = XOFF$ + _
  991.            "System error! Upload aborted <Ctrl-K> continues"
  992. 20675 GOSUB 21650
  993.       IF FILESYS.PARAMETER > 1 THEN _
  994.          RETURN
  995.       CALL DELAYIT (3)
  996.       CALL PUTCOM(XON$)
  997. 20680 CALL EOFCOMM (CHAR%)
  998.       WHILE CHAR% <> -1
  999.          CALL FLUSHCOM(X$)
  1000.          IF INSTR(X$,CHR$(11)) THEN _
  1001.             GOTO 20730
  1002. 20685    CALL CARRIER
  1003.          IF SUBROUTINE.PARAMETER = -1 THEN _
  1004.             FILESYS.PARAMETER = 7 : _
  1005.             RETURN
  1006.       CALL EOFCOMM (CHAR%)
  1007.       WEND
  1008.       GOTO 20680
  1009. '
  1010. ' *  UPDATE UPLOAD DIRECTORY
  1011. '
  1012. 20700 GOSUB 21780
  1013.       IF FILESYS.PARAMETER > 1 THEN _
  1014.          RETURN
  1015. 20702 CALL UPDTUPLOAD (CATEGORY.NAME$(),CATEGORY.CODE$(),LINES.IN.MESSAGE,2)  '<++++++
  1016. '***** AUTO UP MOD *****
  1017.  IF AUTO.END = 1 THEN _                   'AUTO-UP MOD to next comment
  1018. CALL BRKFNAME (FILE.NAME$,DR$,X$,EXTENTION$,TRUE): _
  1019. Z$ = X$+EXTENTION$+DF$+" at "+TIM$ +" using " + FT$ + STR$(BYTES.IN.FILE#) :_
  1020.       CALL UPDTCALR (Z$,2) : _
  1021.      RETURN                             'AUTO-UP MOD
  1022. '***** end of Auto Up Mod****
  1023.       PRIVATE.DOOR = FALSE
  1024.       IF NOT GET.EXT.DESC THEN _
  1025.          GOTO 20710
  1026.       MSG.HEADER$ = "Extended Description for " + FILE.NAME.HOLD$    ' KG072003
  1027.       SYSOP.COMMENT = TRUE
  1028.       MAX.MESSAGE.LINES = MAX.EXTENDED.LINES
  1029.       LL = RIGHT.MARGIN
  1030.       RIGHT.MARGIN = 30 + MAX.DESC.LEN
  1031.       FILESYS.PARAMETER = 5
  1032.       RETURN
  1033. 20705 MAX.MESSAGE.LINES = MAX.MESSAGE.LINES.DEF
  1034.       RIGHT.MARGIN = LL
  1035.              CALL UPDTUPLOAD (CATEGORY.NAME$(),CATEGORY.CODE$(),LINES.IN.MESSAGE,3)  '<++++++
  1036. 20710 ADDING.DESC.ONLY = FALSE
  1037.       IF BYTES.IN.FILE# > 0.0 THEN _
  1038.          GOTO 21770
  1039. 20730 GOSUB 21780
  1040.       CALL QTPUT1 ("Upload aborted")
  1041.       PRIVATE.DOOR = FALSE
  1042. 20735 CALL KILLWORK (FILE.NAME$)
  1043.       IF EC <>0 THEN _
  1044.          EL = 20736 : _
  1045.          GOTO 21900
  1046.       RETURN
  1047. '
  1048. ' *  SYSOP ABORTED UPLOAD
  1049. '
  1050. 20745 A$ = XOFF$ + _
  1051.            "SYSOP aborted upload. Stop tranfer. <Ctrl-K> continues"
  1052.       GOTO 20675
  1053. '
  1054. ' *  CALCULATE DOWNLOAD TIME ESTIMATE
  1055. '
  1056. 20750 START.OF.HEADER$ = CHR$(1 - (INTERNAL.PROTO$ = "Y"))
  1057.       CALL OPENRSEQ (FILE.NAME$,MAX.BLOCK,DF,FLEN)
  1058. 20760 IF EC <> 0 THEN _
  1059.          CALL QTPUT1 ("Unable to access "+FILE.NAME.HOLD$) : _
  1060.          CALL UPDTCALR ("Unable to access "+FILE.NAME$,2) : _
  1061.          OK = FALSE : _
  1062.          EC = 0 : _
  1063.          BYTES.IN.FILE# = 0 : _
  1064.          RETURN
  1065.       BYTES.IN.FILE# = LOF(2)
  1066.       NUM.DNLD.BYTS! = LOF(2)
  1067.       OK = TRUE
  1068.       IF SIZE.ONLY THEN _
  1069.          SIZE.ONLY = FALSE : _
  1070.          RETURN
  1071.       BLOCKS.IN.FILE# = MAX.BLOCK
  1072.       IF BATCH.TRANSFER THEN _
  1073.          TEMP# = BATCH.BLOCKS# + BLOCKS.IN.FILE# : _                 ' KG081502
  1074.          CALL CHKTREMAIN (TIME.REMAINING!) : _                       ' KG081502
  1075.          IF (INT(TEMP# / 60) + 1) > INT(TIME.REMAINING!) THEN _      ' KG081502
  1076.             CALL QTPUT1 ("Omitting " + FILE.NAME.HOLD$ + ".  Insufficient time") : _ ' KG081502
  1077.             RETURN _                                                 ' KG081502
  1078.          ELSE BATCH.BLOCKS# = TEMP# : _                              ' KG081502
  1079.               BATCH.BYTES# = BATCH.BYTES# + BYTES.IN.FILE# : _       ' KG081502
  1080.               CALL OPENWRKA (NODE.WORK.FILE$) : _                    ' KG081502
  1081.               CALL PRNTWRKA (FILE.NAME$) : _                         ' KG081502
  1082.               RETURN                                                 ' KG081502
  1083. 20780 A$ = "File Size    :"
  1084.       OK = TRUE
  1085.       IF BLOCK.SIZE > 0 THEN _
  1086.          A$ = A$ + _
  1087.               STR$(FIX(BLOCKS.IN.FILE#)) + _
  1088.               " blocks "
  1089. 20785 BLOCKS.IN.FILE# = BLOCKS.IN.FILE# / _
  1090.                         VAL(MID$("0000030004501200240048009601920", -4 * BPS, 4))
  1091.       BLOCKS.IN.FILE# = BLOCKS.IN.FILE# * FLEN / SPEED.FACTOR!
  1092.       IF (ANS.INDEX > 1 AND CONCAT.FILES) THEN _                     ' KG081201
  1093.          RETURN
  1094.       A$ = A$ + _
  1095.            STR$(BYTES.IN.FILE#) + _
  1096.            " bytes"
  1097.       GOSUB 21650
  1098.       IF FILESYS.PARAMETER > 1 THEN _
  1099.          RETURN
  1100.       IF BYTES.IN.FILE# < 1 THEN _
  1101.          RETURN
  1102. 20790 SUBROUTINE.PARAMETER = 2
  1103.       CALL LINE25
  1104.       A$ = "Transfer Time:" + _
  1105.          STR$(INT(BLOCKS.IN.FILE# / 60)) + _
  1106.          " min," + _
  1107.          STR$(INT(BLOCKS.IN.FILE# - (INT(BLOCKS.IN.FILE# / 60) * 60))) + _
  1108.          " sec (approx)"
  1109.       GOSUB 21650
  1110.       IF FILESYS.PARAMETER > 1 THEN _
  1111.          RETURN
  1112. 20791 IF PERSONAL.DOWNLOAD THEN _
  1113.          RETURN
  1114.       CALL CHKTREMAIN (TIME.REMAINING!)
  1115.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1116.          FILESYS.PARAMETER = 6 : _
  1117.          RETURN
  1118.       OK = TRUE
  1119.       IF (INT(BLOCKS.IN.FILE# / 60) + 1) > INT(TIME.REMAINING!) THEN _
  1120.          A$ = "Not enough time left!" : _
  1121.          CALL UPDTCALR (FILE.NAME$ + " " + A$,2) : _
  1122.          CALL QTPUT1 (A$): _
  1123.          A$ = "" : _
  1124.          OK = FALSE : _
  1125.          RETURN
  1126. CALL AUTOLOGOFF           'Autologoff mod
  1127.       CALL CHECKRATIO (TRUE)
  1128. '
  1129. '
  1130. ' *** Tell-m.mod as of 09/10/89****** Pete E
  1131. '
  1132. '
  1133. If NOT OK THEN _
  1134.   RETURN                 'Pe 08/27/89
  1135. '
  1136.     NOTIFY$ =  WELCOME.FILE.DRV.PATH$ + _
  1137.      "TELTHEM.DEF"        ' <==== NOTE SPELLING
  1138. CALL FINDIT (NOTIFY$)
  1139.  IF OK THEN _
  1140.      STOP.INTERRUPTS = TRUE : _
  1141.      CALL BUFFILE (NOTIFY$,X)
  1142. '***************************************
  1143.       RETURN
  1144. 20810 CALL SETABORT (DELAY!,6)
  1145. 20840 CALL EOFCOMM (CHAR%)
  1146.       IF CHAR% = -1 THEN _
  1147.          GOTO 20850
  1148.       CALL FLUSHCOM(Y$)
  1149.       RETURN
  1150. 20850 CALL CHECKTIM (DELAY!)
  1151.       ON SUBROUTINE.PARAMETER GOTO 20840,20851
  1152. 20851 Y$ = ""
  1153.       CALL CHKCARRIER                                                ' KG061203
  1154.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1155.          FILESYS.PARAMETER = 7 : _
  1156.          RETURN
  1157.       RETURN
  1158. '
  1159. ' *  XMODEM/YMODEM UPLOAD
  1160. '
  1161. 20860 GOSUB 20992
  1162.       IF FILESYS.PARAMETER > 1 THEN _
  1163.          RETURN
  1164.       IF NOT EIGHT.BIT THEN _
  1165.          GOSUB 21280 : _
  1166.          IF FILESYS.PARAMETER > 1 THEN _
  1167.             RETURN
  1168. 20900 X$ = ""
  1169.       SEC = 1
  1170.       'CALL OPENOUTW (FILE.NAME$)
  1171.       IF FLEN > WRITE.BUF.DEF THEN _
  1172.          WRITE.BUF = FLEN _
  1173.       ELSE WRITE.BUF = WRITE.BUF.DEF
  1174.       CALL OPENRSEQ (FILE.NAME$,Y,DF,WRITE.BUF)
  1175.       IF EC <> 0 AND EC <> 53 THEN _
  1176.          EL = 20900 : _
  1177.          GOTO 21900
  1178.       FIELD #2, WRITE.BUF AS UPLOAD.RECORD$
  1179.       RECS.WRIT = 0
  1180.       NUM.IN.BUFF = 0
  1181.       CALL SETABORT (TRANSFER.ABORT!,WAIT.BEFORE.DISCONNECT)
  1182.       YY$ = " " + _
  1183.             CHR$(1) + _
  1184.             CHR$(2) + _
  1185.             END.TRANSMISSION$ + _
  1186.             CANCEL$
  1187. 20903 CALL PUTCOM (NEGATIVE.ACKNOWLEDGE$)
  1188. 20920 X = 1
  1189. 20922 CALL CHKCARRIER                                                ' KG061203
  1190.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1191.          FILESYS.PARAMETER = 7 : _
  1192.          RETURN
  1193.       CALL FINDFUNC
  1194.       IF KEY.PRESSED$ = ESCAPE$ THEN _
  1195.          GOSUB 20510 :_
  1196.          IF FILESYS.PARAMETER > 1 THEN _
  1197.             RETURN _
  1198.          ELSE GOTO 21240
  1199.       GOSUB 20810
  1200.       IF FILESYS.PARAMETER > 1 THEN _
  1201.          RETURN
  1202. 20930 J = INSTR(YY$,LEFT$(Y$,1))
  1203.       ON J GOTO 20960,20999,20999,21220,21230
  1204. 20960 IF Y$ <> "" THEN _
  1205.          GOSUB 21280 : _
  1206.          IF FILESYS.PARAMETER > 1 THEN _
  1207.             RETURN _
  1208.          ELSE CALL CHECKTIM (TRANSFER.ABORT!) : _
  1209.               ON SUBROUTINE.PARAMETER GOTO 20920,21230
  1210. 20970 X = X + 1
  1211.       CALL DELAYIT (1)
  1212.       CALL PUTCOM (NEGATIVE.ACKNOWLEDGE$)
  1213.       IF X < 6 THEN _
  1214.          GOTO 20922
  1215.       D$ = "Upload Timeout"
  1216.       GOSUB 21710
  1217.       IF FILESYS.PARAMETER > 1 THEN _
  1218.          RETURN
  1219.       CALL CHECKTIM (TRANSFER.ABORT!)
  1220.       ON SUBROUTINE.PARAMETER GOTO 20990,21230
  1221. 20990 GOTO 20920
  1222. '
  1223. ' *  CHANGE TO 8 BIT FOR XMODEM
  1224. '
  1225. 20992 GOSUB 20510
  1226.       IF FILESYS.PARAMETER > 1 THEN _
  1227.          FILESYS.PARAMETER = 2 : _
  1228.          RETURN
  1229.       IF NOT EIGHT.BIT THEN _
  1230.          PREV.LINE.CONTROL = INP (LINE.CONTROL.REGISTER) : _
  1231.          CALL DELAYIT (3) : _
  1232.          SWITCHED.TO.EIGHT = TRUE : _
  1233.          OUT LINE.CONTROL.REGISTER,3
  1234. 20996 SO = 0
  1235.       RETURN
  1236. '
  1237. ' *  EXPECTED BLOCK LENGTH. 132 FOR CHECKSUM, 133 FOR CRC, 1029 FOR YMODEM
  1238. '
  1239. 20999 SOL = 896 * J - 1659 + CHECKSUM
  1240.       DATA.SOL = 128 - (SOL > 1024)*896
  1241.       GOTO 21020
  1242. '
  1243. ' *  XMODEM/YMODEM UPLOAD
  1244. '
  1245. 21000 GOSUB 20810
  1246.       IF FILESYS.PARAMETER > 1 THEN _
  1247.          RETURN
  1248.       IF Y$ = "" THEN _
  1249.          D$ = "Upload Timeout" : _
  1250.          GOSUB 21710 : _
  1251.          IF FILESYS.PARAMETER > 1 THEN _
  1252.             RETURN _
  1253.          ELSE GOTO 21040
  1254. 21020 X$ = X$ + _
  1255.            Y$
  1256.       IF LEN(X$) < SOL THEN _
  1257.          GOTO 21000
  1258. 21040 IF LEN(X$) = SOL THEN _
  1259.          GOTO 21090
  1260. 21050 IF LEN(X$) > SOL THEN _
  1261.          GOTO 21180
  1262. 21060 IF X$ = END.TRANSMISSION$ THEN _
  1263.          GOTO 21220
  1264. 21070 IF X$ = CANCEL$ THEN _
  1265.          GOTO 21230
  1266. 21080 GOTO 21170
  1267. 21090 JX = ASC(MID$(X$,2,1))
  1268.       IF SEC = JX THEN _
  1269.          GOTO 21100
  1270.       IF SEC > JX THEN _
  1271.          CALL PUTCOM (RIGHT$(ACKC$,1 - (JX = 0))) : _
  1272.          GOTO 21150
  1273.       GOTO 21200
  1274. 21100 IF (SEC XOR 255) <> ASC(MID$(X$,3,1)) THEN _
  1275.          GOTO 21210
  1276. 21110 IF CHECKSUM THEN _
  1277.          WK$ = MID$(X$,4,128) : _
  1278.          GOSUB 21750 : _
  1279.          IF FILESYS.PARAMETER > 1 THEN _
  1280.             RETURN _
  1281.          ELSE IF XMODEM.CHECKSUM <> ASC(MID$(X$,132,1)) THEN _
  1282.             GOTO 21190 _
  1283.          ELSE GOTO 21120
  1284.       WK$ = MID$(X$,4)
  1285.       GOSUB 21750
  1286.       IF FILESYS.PARAMETER > 1 THEN _
  1287.          RETURN
  1288. 21113 IF CRC.VALUE <> 0 THEN _
  1289.          GOTO 21191
  1290. 21120 SO = SO + 1
  1291.       CALL PUTCOM (ACKNOWLEDGE$)
  1292. 21131 IF NUM.IN.BUFF >= WRITE.BUF THEN _
  1293.          NUM.IN.BUFF = 0 : _
  1294.          CALL PUTWORK (UPLOAD.RECORD$,RECS.WRIT,WRITE.BUF) : _
  1295.          IF EC <> 0 THEN _
  1296.             EL = 21131 : _
  1297.             GOTO 21900
  1298.       MID$(UPLOAD.RECORD$,NUM.IN.BUFF+1,DATA.SOL) = WK$
  1299.       NUM.IN.BUFF = NUM.IN.BUFF + DATA.SOL
  1300. 21145 SEC = 255 AND (SEC + 1)
  1301.       CALL QLPRNT ("OK Rec Blk #",SO)
  1302. 21150 X$ = ""
  1303.       XMODEM.CHECKSUM = 0
  1304.       CALL SETABORT(TRANSFER.ABORT!,45)
  1305.       GOTO 20920
  1306. 21170 A$ = "Short Blk #"
  1307.       GOTO 21212
  1308. 21180 A$ = "Long Blk #"
  1309.       GOTO 21212
  1310. 21190 A$ = "Chksum Error #"
  1311.       GOTO 21212
  1312. 21191 A$ = "CRC Error"
  1313.       GOTO 21212
  1314. 21200 A$ = "Blk # Error in #"
  1315.       JX = ASC(MID$(X$,2,1))
  1316.       IF SEC < JX THEN _
  1317.          GOTO 21212
  1318.       CALL PUTCOM (ACKNOWLEDGE$) ' RIGHT$(ACKC$,1 - (JX = 0)))
  1319.       GOTO 21150
  1320. 21210 A$ = "Complement Error in #"
  1321. 21212 GOSUB 21280
  1322.       IF FILESYS.PARAMETER > 1 THEN _
  1323.          RETURN
  1324.       CALL PUTCOM (NEGATIVE.ACKNOWLEDGE$)
  1325.       CALL LPRNT(LINE.FEED$ + A$ + STR$(SO + 1),0)
  1326.       GOTO 21150
  1327. 21220 IF NUM.IN.BUFF < 1 THEN _
  1328.          GOTO 21225
  1329.       WK$ = LEFT$(UPLOAD.RECORD$,NUM.IN.BUFF)
  1330.       CALL OPENRSEQ (FILE.NAME$,MAX.BLOCK,DF,128)
  1331.       FIELD #2, 128 AS UPLOAD.RECORD$
  1332.       MAX.BLOCK = CDBL(RECS.WRIT) * WRITE.BUF / 128
  1333.       FOR I = 1 TO NUM.IN.BUFF/128
  1334.          CALL PUTWORK (MID$(WK$,128*I-127,128),MAX.BLOCK,128)
  1335.          IF EC > 0 THEN _
  1336.             EL = 21220 : _
  1337.             GOTO 21900
  1338.       NEXT
  1339.       CLOSE 2
  1340. 21225 CALL PUTCOM (ACKNOWLEDGE$)
  1341.       GOTO 21250
  1342. 21230 D$ = LINE.FEED$ + _
  1343.            "Transfer Aborted"
  1344.       GOSUB 21710
  1345.       IF FILESYS.PARAMETER > 1 THEN _
  1346.          RETURN
  1347. 21240 CALL EOFCOMM (CHAR%)
  1348.       IF CHAR% <> -1 THEN _
  1349.          GOSUB 21280 : _
  1350.          IF FILESYS.PARAMETER > 1 THEN _
  1351.             RETURN _
  1352.          ELSE CALL DELAYIT (1) : _
  1353.          GOTO 21240
  1354.       CALL PUTCOM (CANCEL$ + CANCEL$)
  1355.       CALL DELAYIT (1)
  1356.       CALL EOFCOMM (CHAR%)
  1357.       IF CHAR% <> -1 THEN _
  1358.          GOTO 21240
  1359.       OK = FALSE
  1360. 21250 EIGHT.BIT = TRUE
  1361.       RETURN
  1362. '
  1363. ' *  CLEAR GARBAGE OUT OF COMMUNICATIONS BUFFER
  1364. '
  1365. 21280 CALL CHKCARRIER                                                ' KG061203
  1366.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1367.          FILESYS.PARAMETER = 7 : _
  1368.          RETURN
  1369.       CALL EOFCOMM (CHAR%)
  1370.       IF CHAR% = -1 THEN _
  1371.          RETURN
  1372. 21281 CALL FLUSHCOM(DF$)
  1373.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1374.          FILESYS.PARAMETER = 7 : _                                   ' KG081201
  1375.          RETURN
  1376.       GOTO 21280
  1377. '
  1378. ' *  XMODEM/YMODEM DOWNLOAD
  1379. '
  1380. 21300 GOSUB 20992
  1381.       IF FILESYS.PARAMETER > 1 THEN _
  1382.          RETURN
  1383.       SEC = 0
  1384.       GOSUB 21280
  1385.       IF FILESYS.PARAMETER > 1 THEN _
  1386.          RETURN
  1387.       NEGATIVE.ACKNOWLEDGE$ = CHR$(21)
  1388.       CALL SETABORT (TRANSFER.ABORT!,WAIT.BEFORE.DISCONNECT)
  1389.    CALL OPENRSEQ (FILE.NAME$,MAX.BLOCK,DF,FLEN)  'Pe 08/15/89
  1390. 21303 FIELD 2,FLEN AS DOWNLOAD.RECORD$
  1391. '
  1392. ' *  ROUTINE TO START AN "XMODEM" OR "YMODEM" DOWNLOAD.  CHECK'S INITIAL
  1393. ' *  "HANDSHAKE" TO SEE IF CHARACTER IS SENT IS A:
  1394. ' *           "X" = XMODEM WITH CHECKSUM AND 128 CHARACTER RECORDS
  1395. ' *           "C" = XMODEM WITH CRC CHECK AND 128 CHARACTER RECORDS
  1396. ' *           "Y" = YMODEM WITH CRC CHECK AND 1024 CHARACTER RECORDS
  1397. '
  1398. 21350 CALL EOFCOMM (CHAR%)
  1399.       WHILE CHAR% <> -1
  1400. 21360    CALL GETCOM(Y$)
  1401.          IF Y$ = CANCEL$ THEN _
  1402.             GOTO 21560
  1403. 21380    CHECKSUM = (Y$ = NEGATIVE.ACKNOWLEDGE$)
  1404.          IF CHECKSUM THEN _
  1405.             FF = INSTR(INTERNAL.EQUIV$,"X") : _
  1406.             IF FF > 0 THEN _
  1407.                FT$ = MID$(DFLTXFER$,FF,1) : _
  1408.                GOTO 21480 _
  1409.             ELSE FT$ = "X" : _
  1410.                  GOTO 21480 _
  1411.          ELSE IF Y$ = "C" THEN _
  1412.                  GOTO 21480
  1413.          CALL EOFCOMM (CHAR%)
  1414. 21390 WEND
  1415.       GOSUB 21460
  1416.       IF FILESYS.PARAMETER > 1 THEN _
  1417.          RETURN
  1418.       IF KEY.PRESSED$ = ESCAPE$ THEN _
  1419.          RETURN
  1420.       CALL CHECKTIM (TRANSFER.ABORT!)
  1421.       ON SUBROUTINE.PARAMETER GOTO 21350,21455
  1422. 21410 CALL SETABORT (TRANSFER.ABORT!, WAIT.BEFORE.DISCONNECT)
  1423. '
  1424. ' *  ROUTINE TO WAIT FOR AN ACKNOWLEDGEMENT ON AN "XMODEM" OR "YMODEM"
  1425. ' *  DOWNLOAD
  1426. '
  1427. 21415 CALL EOFCOMM (CHAR%)
  1428.       IF CHAR% <> -1 THEN _
  1429.          GOTO 21420
  1430.       GOSUB 21460
  1431.       IF FILESYS.PARAMETER > 1 THEN _
  1432.          RETURN
  1433.       IF KEY.PRESSED$ = ESCAPE$ THEN _
  1434.          RETURN
  1435.       CALL CHECKTIM (TRANSFER.ABORT!)
  1436.       ON SUBROUTINE.PARAMETER GOTO 21415,21455
  1437. 21420 CALL GETCOM(Y$)
  1438.       IF Y$ = ACKNOWLEDGE$ THEN _
  1439.          GOTO 21470
  1440. 21440 IF Y$ <> NEGATIVE.ACKNOWLEDGE$ THEN _
  1441.          GOTO 21450
  1442. 21443 D$ = LINE.FEED$ + _
  1443.          "Error -> retrans #" + _
  1444.          STR$(SO)
  1445.       GOSUB 21710
  1446.       IF FILESYS.PARAMETER > 1 THEN _
  1447.          RETURN
  1448. 21445 SO = SO - 1
  1449.       GOTO 21490
  1450. 21450 IF Y$ = CANCEL$ THEN _
  1451.          IF HAVE.A.CANCEL THEN _
  1452.             GOTO 21560 _
  1453.          ELSE HAVE.A.CANCEL = TRUE
  1454.       CALL CHECKTIM (TRANSFER.ABORT!)
  1455.       ON SUBROUTINE.PARAMETER GOTO 21415,21455
  1456. 21455 D$ = "Download timeout"
  1457.       GOSUB 21710
  1458.       IF FILESYS.PARAMETER > 1 THEN _
  1459.          RETURN
  1460.       GOTO 21560
  1461. 21460 CALL CHKCARRIER                                                ' KG061203
  1462.       CALL FINDFUNC
  1463.       IF SUBROUTINE.PARAMETER < 0 THEN _
  1464.          FILESYS.PARAMETER = 7 : _
  1465.          RETURN
  1466.       IF KEY.PRESSED$ = ESCAPE$ THEN _
  1467.          GOTO 21540
  1468.       RETURN
  1469. '
  1470. ' *  DISPLAY BLOCK SENT OK AND THEN READ IN NEXT RECORD FROM DISK TO DOWNLOAD
  1471. '
  1472. 21470 CALL QLPRNT ("OK Sent Blk #",SO)
  1473. 21480 IF LOC(2) => MAX.BLOCK THEN _
  1474.          GOTO 21530
  1475.       CALL GETWORK (FLEN)
  1476.       IF EC <> 0 THEN _
  1477.          EL = 21480 : _
  1478.          GOTO 21900
  1479.       SEC = 255 AND (SEC + 1)
  1480.       GOTO 21490
  1481. '
  1482. ' *  ROUTINE TO WRITE OUT AN "XMODEM" OR "YMODEM" RECORD TO THE COMM. PORT
  1483. '
  1484. 21490 SO = SO + 1
  1485.       CALL PUTCOM (START.OF.HEADER$ + CHR$(SEC) + CHR$(SEC XOR 255))
  1486.       CALL PUTCOM (DOWNLOAD.RECORD$)
  1487.       HAVE.A.CANCEL = FALSE
  1488. 21503 WK$ = DOWNLOAD.RECORD$
  1489. 21504 GOSUB 21750
  1490.       IF FILESYS.PARAMETER > 1 THEN _
  1491.          RETURN
  1492. 21510 IF CHECKSUM THEN _
  1493.          CALL PUTCOM(CHR$(XMODEM.CHECKSUM)) _
  1494.       ELSE CALL PUTCOM(CHR$(CRC.HIGH) + CHR$(CRC.LOW))
  1495.       GOSUB 21280
  1496.       IF FILESYS.PARAMETER > 1 THEN _
  1497.          RETURN
  1498.       GOTO 21410
  1499. '
  1500. ' *  END-OF-FILE FOR XMODEM DOWNLOADS -- SEND THE "EOT" CHARACTER AND WAIT UP
  1501. ' *  TO 2 SECONDS FOR A POSITIVE RESPONSE (I.E. AN "ACK").  IF NONE IS
  1502. ' *  RE-TRY UP TO 10 TIMES.  IF NO POSITIVE RESPONSE IS RECEIVED AFTER TEN
  1503. ' *  ATTEMPTS, ASSUME THE DOWNLOAD WAS UNSUCCESSFULL.
  1504. '
  1505. 21530 CALL PUTCOM (END.TRANSMISSION$)
  1506.       X = 1
  1507. 21531 GOSUB 20810
  1508.       IF FILESYS.PARAMETER > 1 THEN _
  1509.          RETURN
  1510.       IF INSTR(Y$,ACKNOWLEDGE$) THEN _
  1511.          GOTO 21550
  1512.       CALL FINDFUNC
  1513.       IF SUBROUTINE.PARAMETER < 0 THEN _
  1514.          FILESYS.PARAMETER = 2 : _
  1515.          RETURN
  1516.       IF KEY.PRESSED$ = ESCAPE$ THEN _
  1517.          GOSUB 21540 : _
  1518.          GOTO 21545
  1519.       IF X < 10 THEN _
  1520.          X = X + 1 : _
  1521.          GOTO 21531
  1522.       DOWNLOAD.COMPLETED = FALSE
  1523.       GOTO 21230
  1524. 21540 GOSUB 20510
  1525.       IF FILESYS.PARAMETER > 1 THEN _
  1526.          RETURN
  1527.       RETURN
  1528. 21545 Y$ = CANCEL$
  1529.       CALL PUTCOM (CANCEL$ + CANCEL$ + CANCEL$)
  1530.       DOWNLOAD.COMPLETED = FALSE
  1531.       GOTO 21250
  1532. 21550 DOWNLOAD.COMPLETED = TRUE
  1533.       GOTO 21250
  1534. 21560 DOWNLOAD.COMPLETED = FALSE
  1535.       D$ = LINE.FEED$ + _
  1536.            "Caller aborted trans"
  1537.       GOSUB 21710
  1538.       IF FILESYS.PARAMETER > 1 THEN _
  1539.          RETURN
  1540.       GOTO 21545
  1541. '
  1542. ' STANDARD ENTRY FOR RBBS-PC'S COMMON TERMINAL OUTPUT ROUTINE
  1543. '
  1544. ' Modeled on lines 12975 to 12983 in RBBS-PC.BAS
  1545. 21630 SUBROUTINE.PARAMETER = 1
  1546.       GOTO 21655
  1547. 21640 SUBROUTINE.PARAMETER = 3
  1548.       GOTO 21655
  1549. 21650 SUBROUTINE.PARAMETER = 5
  1550. 21655 CALL TPUT
  1551.       IF SUBROUTINE.PARAMETER < 0 THEN _
  1552.          FILESYS.PARAMETER = 2 : _
  1553.          RETURN
  1554.       IF SUBROUTINE.PARAMETER = 8 THEN _
  1555.          GOSUB 21660
  1556.       RETURN
  1557. '
  1558. ' STANDARD ENTRY FOR RBBS-PC'S COMMON TERMINAL INPUT ROUTINE
  1559. '
  1560. ' Modeled on lines 12995 to 12997 in RBBS-PC.BAS
  1561. 21660 SUBROUTINE.PARAMETER = 1
  1562.       CALL TGET
  1563. 21665 IF SUBROUTINE.PARAMETER < 0 THEN _                             ' KG081201
  1564.          FILESYS.PARAMETER = 2
  1565.       RETURN
  1566. 21668 CALL POPCSTACK                                                 ' KG081201
  1567.       GOTO 21665                                                     ' KG081201
  1568. 21700 EC = 0
  1569.       RETURN
  1570. '
  1571. ' **** COMMON LOCAL DISPLAY PRINT ***
  1572. '
  1573. '  (formerly lines 1315 to 1320 in RBBS-PC.BAS CPC16-1A
  1574. 21710 NUM.RETURNS = 1
  1575. 21720 CALL LPRNT (D$,NUM.RETURNS)
  1576.       RETURN
  1577. '
  1578. ' *  XMODEM / CRC INTERFACE
  1579. '
  1580. '  (formerly line 46000 in RBBS-PC.BAS CPC16-1A
  1581. 21750 XMODEM.CHECKSUM = 0
  1582.       CRC.VALUE = 0
  1583.       CALL XMODEM(WK$,XMODEM.CHECKSUM,CRC.VALUE,CRC.HIGH,CRC.LOW)
  1584.       RETURN
  1585. '
  1586. ' * UPDATE DOWNLOAD STATISTICS
  1587. '
  1588. '  (formerly lines 50600 to 50614 in RBBS-PC.BAS CPC16-1A
  1589. 21760 GOSUB 21780
  1590.       IF FILESYS.PARAMETER > 1 THEN _
  1591.          RETURN
  1592.       IF BATCH.TRANSFER THEN _
  1593.          CALL LINESNFIL (NODE.WORK.FILE$,DOWN.FILES) _
  1594.       ELSE DOWN.FILES = 1
  1595.       IF NOT DOWNLOAD.COMPLETED THEN _
  1596.          AUTO.LOGOFF = FALSE : _
  1597.          DF$ = " Aborted" _
  1598.       ELSE CALL LOGDOWN (PERSONAL.DOWNLOAD,1+ANS.INDEX-FIRST.DOWNLOAD) : _  ' KG082601
  1599.            DOWNLOADS = DOWNLOADS + DOWN.FILES : _
  1600.            GLOBAL.DL.TODAY! = GLOBAL.DL.TODAY! + DOWN.FILES : _
  1601.            GLOBAL.DOWNLOADS = GLOBAL.DOWNLOADS + DOWN.FILES : _
  1602.            DLBYTES! = DLBYTES! + NUM.DNLD.BYTS! : _
  1603.            GLOBAL.DLBYTES! = GLOBAL.DLBYTES! + NUM.DNLD.BYTS! : _
  1604.            DL.TODAY! = DL.TODAY! + DOWN.FILES : _
  1605.            BYTES.TODAY! = BYTES.TODAY! + NUM.DNLD.BYTS! : _
  1606.            GLOBAL.BYTES.TODAY! = GLOBAL.BYTES.TODAY! + NUM.DNLD.BYTS! : _ ' KG102004
  1607.            NUM.DNLD.BYTS! = 0 : _
  1608.            DF$ = " Downloaded" : _
  1609.            IF (ANS.INDEX = LAST.DOWNLOAD OR NOT CONCAT.FILES) THEN _ ' KG081201
  1610.               CALL SKIPLINE (1) : _
  1611.               CALL QTPUT1 ("Download successful")
  1612. '      IF AUTODOWNLOAD.IN.PROGRESS THEN _
  1613. '         DF$ = " AUTO" + _
  1614. '              MID$(N$,2)
  1615.       IF INSTR(N$,"Aborted") THEN _
  1616.          AUTODOWNLOAD.IN.PROGRESS = 0
  1617.       A$ = ""
  1618. 21770 CALL AMORPM                                                    ' KG061203
  1619.       IF NOT BATCH.TRANSFER THEN _
  1620.          GOTO 21773
  1621.       CALL OPENWORK (2,NODE.WORK.FILE$)
  1622.       IF EC > 0 THEN _
  1623.          RETURN
  1624.       Q = 0
  1625.       WHILE NOT EOF(2)
  1626.          CALL READANY
  1627.          Q = Q + 1
  1628.          B$(Q) = A$
  1629.       WEND
  1630. 21772 IF Q < 1 THEN _
  1631.          BATCH.TRANSFER = FALSE : _
  1632.        CALL CHECKRATIO (FALSE):_
  1633.          RETURN
  1634.       CALL OPENWORK (2,B$(Q))
  1635.       IF EC > 0 THEN _
  1636.          EC = 0 : _
  1637.          Q = Q - 1 : _
  1638.          GOTO 21772
  1639.       BYTES.IN.FILE# = LOF(2)
  1640.       FILE.NAME$ = B$(Q)
  1641. 21773 CALL BRKFNAME (FILE.NAME$,DR$,X$,EXTENTION$,TRUE)
  1642.       Z$ = X$ + _
  1643.            EXTENTION$ + _
  1644.            DF$ + _
  1645.            " at " + _
  1646.            TIM$ + _
  1647.            " using " + _
  1648.            FT$ + _
  1649.            STR$(BYTES.IN.FILE#)
  1650.       CALL UPDTCALR (Z$,2)
  1651.       IF BATCH.TRANSFER THEN _
  1652.          Q = Q - 1 : _
  1653.          GOTO 21772
  1654.       CALL CHECKRATIO (FALSE)
  1655. 21774 IF MENU.INDEX = 6 THEN _
  1656.          IF DOWNLOAD.COMPLETED THEN _
  1657.             A$ = X$ : _
  1658.             SUBROUTINE.PARAMETER = 5 : _
  1659.             CALL LIBRARY
  1660.       RETURN
  1661. '
  1662. ' *****   TURN ON INTERMEDIATE ECHO   ****
  1663. '
  1664. '  (formerly line 50620 in RBBS-PC.BAS CPC16-1A
  1665. 21780 IF ECHOER$ = "I" THEN _
  1666.          CALL SETECHO ("I")
  1667. '
  1668. ' *  RESTORE COMMUNICATIONS AFTER SWITCH TO 8 BIT
  1669. '
  1670. '  (formerly between lines 50620 and 50630 in RBBS-PC.BAS CPC16-1A
  1671.       IF SWITCHED.TO.EIGHT THEN _
  1672.          IF SWITCH.BACK THEN _
  1673.             OUT LINE.CONTROL.REGISTER, PREV.LINE.CONTROL : _
  1674.             CALL DELAYIT (3) : _
  1675.             EIGHT.BIT = FALSE : _
  1676.             SWITCHED.TO.EIGHT = FALSE
  1677.       RETURN
  1678. '
  1679. ' *****  TURN OFF INTERMEDIATE ECHO  ****
  1680. '
  1681. '  (formerly line 50630 in RBBS-PC.BAS CPC16-1A
  1682. 21790 IF ECHOER$ = "I" THEN _
  1683.          CALL SETECHO ("R")
  1684.       RETURN
  1685. '
  1686. ' *****   DIRECTORY SEARCH   ****
  1687. '
  1688. '  (formerly lines 52900 to 52920 in RBBS-PC.BAS CPC16-1A
  1689. 21800 CK = 2                                                         ' KG081201
  1690. 21810 A$ = "Search for (in file name/desc, wildcards name only, [ENTER] quits)"
  1691.       MACRO.MIN = 99
  1692.       GOSUB 21668                                                    ' KG081201
  1693.       IF Q = 0 THEN _
  1694.          RETURN
  1695. 21820 RS$ = B$(ANS.INDEX)                                            ' KG081201
  1696.       WILD.SEARCH = (INSTR(RS$,"*") > 0 OR INSTR(RS$,"?") > 0)
  1697.       CALL ALLCAPS (RS$)
  1698.       SEARCH.STRING$ = RS$
  1699.       SEARCH.DATE$ = ""
  1700.       A1$ = RS$
  1701.       GOTO 21867
  1702. '
  1703. ' *****  P - personal download  ****
  1704. '
  1705. '  (formerly lines 52950 to 52952 in RBBS-PC.BAS CPC16-1A
  1706. 21850 IF PERSONAL.BEGIN < 1 OR PERSONAL.LEN < 1 THEN _
  1707.          RETURN
  1708.       DOWNLOAD.FLAG = 0
  1709.       PERSONAL.DOWNLOAD = TRUE
  1710. 21852 CALL PERSFILE (MID$(USER.RECORD$,PERSONAL.BEGIN,PERSONAL.LEN),_
  1711.                      DOWNLOAD.FLAG)
  1712.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1713.          FILESYS.PARAMETER = 7: _
  1714.          RETURN
  1715.       IF LAST.INDEX <= 0 THEN _                                      ' KG082601
  1716.          GOTO 21854
  1717.       CONCAT.FILES = PERSONAL.CONCAT
  1718.       STOP.INTERRUPTS = TRUE
  1719.       TIME.LOCK.EXEMPT = TRUE
  1720.       GOSUB 20202
  1721.       IF FILESYS.PARAMETER > 1 THEN _
  1722.          GOTO 21854
  1723.       TIME.LOCK.EXEMPT = FALSE
  1724.       CONCAT.FILES = FALSE
  1725.       GOTO 21852
  1726. 21854 PERSONAL.DOWNLOAD = FALSE
  1727.       RETURN
  1728. '
  1729. ' *  N - COMMAND FROM FILES MENU (DISPLAY NEW FILES SINCE LAST DIR DISPLAY)
  1730. '
  1731. '  (formerly lines 53000 to 53070 in RBBS-PC.BAS CPC16-1A
  1732. 21860 CK = 1                                                         ' KG081201
  1733. 21862 A1$ = RIGHT$(LM$,4) +_
  1734.             LEFT$(LM$,2)
  1735.       A$ = "Files on/after (MMDDYY, [ENTER] = last on " + _
  1736.            A1$ + _
  1737.            ")"
  1738.       GOSUB 21668                                                    ' KG081201
  1739.       IF Q = 0 THEN _
  1740.          RS$ = LM$ : _
  1741.          GOTO 21866                                                  ' KG081202
  1742. 21865 IF LEN(B$(ANS.INDEX)) <> 6 THEN _                              ' KG081201
  1743.          GOTO 21862
  1744.       A1$ = B$(ANS.INDEX)                                            ' KG081201
  1745.       RS$ = RIGHT$(A1$,2) + _
  1746.             LEFT$(A1$,4)
  1747. 21866 SEARCH.DATE$ = RS$
  1748.       SEARCH.STRING$ = ""
  1749.       LIST.NEW = TRUE                                    'Pe 09/10/89
  1750. 21867 '
  1751. 21871 B$(1) = "ALL"
  1752.       CALL CONVDIRS (ANS.INDEX)                                      ' KG090205
  1753.       LIST.DIRECTORY = TRUE                                          ' KG083002
  1754.      SEARCHING.ALL = TRUE                             ' Pe 09/10/89
  1755. 21875 Z$ = B$(ANS.INDEX)                                             ' KG081201
  1756.       IF NOT SEARCHING.ALL THEN _                                    ' KG081201
  1757.          IF Z$ = "ALL" THEN _                                        ' KG081201
  1758.             IF NOT LIMIT.SEARCH.TO.FMS THEN _                        ' KG081201
  1759.                GOTO 21890                                            ' KG081201
  1760. 21880 QX = ANS.INDEX                                                 ' KG081201
  1761.       GOSUB 20157                                                    ' KG081201
  1762.       IF FILESYS.PARAMETER > 1 THEN _
  1763.          RETURN
  1764.       ANS.INDEX = ANS.INDEX + 1                                      ' KG081201
  1765.       IF ANS.INDEX <= LAST.INDEX THEN _                              ' KG090205
  1766.          GOTO 21875
  1767.       LIST.NEW = FALSE
  1768.       SEARCH.STRING$ = ""
  1769.       SEARCH.DATE$ = ""
  1770.       RETURN
  1771. 21890 G = ANS.INDEX                                                  ' KG083002
  1772.       CALL GETALL (DIRECTORY.PATH$ + DIRECTORY.PREFIX$ + "." + DIRECTORY.EXTENTION$,B$(),DIRECTORY.EXTENTION$,G)
  1773.       SEARCHING.ALL = TRUE
  1774.       LAST.INDEX = G                                                 ' KG081201
  1775.       ANS.INDEX = ANS.INDEX + 1                                      ' KG081201
  1776.       GOTO 20157                                                     ' KG081201
  1777. '
  1778. ' *  MAIN FILE SYSTEM ERROR TRAP - ALL ERRORS PASS THROUGH THIS ROUTINE
  1779. '
  1780. '  (formerly lines 13000 to 13500 in RBBS-PC.BAS CPC16-1A
  1781. 21900 IF DEBUG THEN _
  1782.          A$ = "RBBSSUB5 DEBUG Error Trap Entry ERL=" + _
  1783.               STR$(EL) + _
  1784.               " ERR=" + _
  1785.               STR$(EC) : _
  1786.          IF PRINTER THEN _
  1787.             CALL PRINTIT(A$) _
  1788.          ELSE CALL LPRNT(A$,1)
  1789.       IF EL = 20126 AND EC = 53 THEN _
  1790.          GOTO 20142
  1791.       IF EL = 20242 AND EC = 62 THEN _
  1792.          CALL UPDTCALR (FILESEC.FILE$ + " bad format!",2) : _
  1793.          GOTO 20247
  1794.       IF EL = 20262 THEN _
  1795.          A$ = "<Download aborted>" : _
  1796.          DOWNLOAD.COMPLETED = FALSE : _
  1797.          GOTO 20390
  1798.       IF EL = 20452 AND EC = 53 THEN _
  1799.          GOTO 20451
  1800.       IF EL = 20560 AND EC = 67 THEN _
  1801.          GOTO 20451
  1802.       IF EL = 20560 AND EC = 70 THEN _
  1803.          IF VAL(FREE.SPACE$) > 1999 THEN _
  1804.             GOTO 20610 _
  1805.          ELSE CALL QTPUT1 ("No room for uploads. Try tomorrow.") : _
  1806.               GOTO 21700
  1807.       IF EL = 20620 THEN _
  1808.          GOTO 20670
  1809.       IF EL = 20650 THEN _
  1810.          GOTO 20670
  1811.       IF EL = 20736 AND EC = 53 THEN _
  1812.          GOTO 21700
  1813.       IF EL = 20900 AND EC = 75 THEN _
  1814.          GOTO 21230
  1815.       IF EL = 20900 AND EC = 70 THEN _
  1816.          CALL QTPUT1 ("No room for uploads. Try tomorrow.") : _
  1817.          GOTO 21230
  1818.       IF EL = 21131 OR EL = 21220 THEN _
  1819.          EC = 0 : _
  1820.          GOTO 21230
  1821.       IF EL = 21480 THEN _
  1822.          CALL LOGERROR : _
  1823.          IF EC = 57 THEN _
  1824.             CALL QTPUT1 ("Error reading file.  Aborting download") : _
  1825.             DOWNLOAD.COMPLETED = FALSE : _
  1826.             GOTO 21230
  1827. 21910 CALL LOGERROR
  1828.       CALL QTPUT1 (CALLERS.RECORD$)
  1829.       FILESYS.PARAMETER = 3
  1830.       RETURN
  1831. 21920 ' EXIT RBBS-PC FILE SUBSYSTEM
  1832.       END SUB
  1833. ' $SUBTITLE: 'GETCOLOR - subroutine to see if user wants color'
  1834. ' $PAGE
  1835. '
  1836.   SUB GETCOLOR STATIC
  1837. '******************************************************************************
  1838. '* Find out if user wants COLOR before getting name                           *
  1839. '*                                                                            *
  1840. '* The color values are as follows                                            *
  1841. '* CX$(1)= red   CX$(2) = GREEN      CX$(3) = YELLOW       CX$(4) = BLUE      *
  1842. '* CX$(5)= MAGENTA  CX$(6) = CYAN   CX$(7) = WHITE       CX$(8)= BRT.WHITE    *
  1843. '*                                                                            *
  1844. '******************************************************************************
  1845. '
  1846. 21935 'CALL SKIPLINE(2)
  1847.     'A$ = CHR$(7)+"Do you want IBM Color (Y/[N]) "
  1848.     'TURBO.KEY = T.KEY
  1849.     'CALL TGET
  1850.     'IF Q = 0 THEN_
  1851.     '  GOTO 21940
  1852.     'IF NOT YES THEN GOTO 21940
  1853.    IF GR < 2  then GOTO 21940
  1854.     CX$(1) = CHR$(27) + "[01;31;40m": CX$(2) = CHR$(27) + "[01;32;40m"
  1855.     CX$(3) = CHR$(27) + "[01;33;40m": CX$(4) = CHR$(27) + "[01;34;40m"
  1856.     CX$(5) = CHR$(27) + "[01;35;40m": CX$(6) = CHR$(27) + "[01;36;40m"
  1857.     CX$(7) = CHR$(27) + "[01;37;40m": CX$(8) = CHR$(27) + "[01;37;40m"
  1858.     EXIT SUB
  1859. '
  1860. '******************************************************************************
  1861. '*  Turn Off Color if User does Not want it                                   *
  1862. '******************************************************************************
  1863. '
  1864. 21940 '
  1865. CX$(1) = "": CX$(2) = "": CX$(3) = "": CX$(4) = "": CX$(5) = ""
  1866. CX$(6) = "": CX$(7) = "": CX$(8) = ""
  1867. END SUB
  1868. '******************** INSERTED AUTO.LOGOFF here ******************
  1869. '
  1870. ' $SUBTITLE: 'AUTOLOGOFF - Subroutine to  to log off after transfer'
  1871. ' $PAGE
  1872. '
  1873.   SUB AUTOLOGOFF STATIC
  1874.  AUTO.END = 0
  1875.   IF GET.EXT.DESC = TRUE THEN _
  1876.     EXIT SUB
  1877.  SUBROUTINE.PARAMETER = 1
  1878.    A$ = CHR$(7)+CX$(2)+"Auto-"+_
  1879.         CX$(5)+"LogOff"+CX$(2)+" after the transfer"+_
  1880.         CX$(3)+" ?(Y/[N]) "+CX$(7)+CHR$(7)
  1881. CALL QTPUT(A$,0)
  1882.      A$=""
  1883.     TURBO.KEY = -TURBO.KEY.USER
  1884.       CALL TGET
  1885.        IF NOT YES THEN _
  1886.      CALL SKIPLINE (1) : _
  1887.      EXIT SUB 
  1888.  AUTO.END = 1
  1889.  CALL SKIPLINE (1)
  1890. END SUB
  1891. 63100 ' $SUBTITLE: 'DOORRTN - Subroutine to process requests from a door'
  1892. ' $PAGE
  1893. '
  1894. '  NAME    -- DOORRTN
  1895. '
  1896. '  INPUTS  -- PARAMETER                      MEANING
  1897. '             DOUTx.DEF               File of requests
  1898. '
  1899. '  OUTPUTS -- USER.SECURITY.LEVEL     Revised Security Level
  1900. '
  1901. '  PURPOSE -- To give Doors a stable way to make requests
  1902. '             to the host.
  1903. '
  1904.       SUB DOORRTN STATIC
  1905.       IF PRIVATE.DOOR OR NOT EXIT.TO.DOORS THEN _
  1906.          EXIT SUB
  1907.       FILE.NAME$ = "DOUT" + NODE.ID$ + ".DEF"
  1908.       CALL FINDIT (FILE.NAME$)
  1909.       IF NOT OK THEN _
  1910.          EXIT SUB
  1911. 63105 IF EOF(2) THEN _
  1912.          GOTO 63195
  1913.       CALL READPARMS (A$(),2,1)
  1914.       IF EC > 0 THEN _
  1915.          GOTO 63115
  1916.       IF LEN(A$(1)) < 2 THEN _
  1917.          EXIT SUB
  1918.       B$ = LEFT$(A$(1),2) + ","
  1919.       X = INSTR("SL,UR,",B$)
  1920.       IF X = 0 THEN _
  1921.          GOTO 63105
  1922.       X = X\3 + 1
  1923.       ON X GOTO 63110,63115
  1924.       GOTO 63105
  1925. 63110 X$ = LEFT$(A$(2),1)         ' SL = Security Level
  1926.       CALL CHECKINT (A$(2))
  1927.       IF EC > 0 THEN _
  1928.          GOTO 63105
  1929.       IF X$ = "+" OR X$ = "-" THEN _
  1930.          A = USER.SECURITY.LEVEL + TESTED.INTEGER.VALUE _
  1931.       ELSE A = TESTED.INTEGER.VALUE
  1932.       IF A < SYSOP.SECURITY.LEVEL THEN _
  1933.          ADJUSTED.SECURITY = (A <> USER.SECURITY.LEVEL) : _
  1934.          IF ADJUSTED.SECURITY THEN _
  1935.             USER.SECURITY.LEVEL = A : _
  1936.             MID$(USER.RECORD$,47,2) = MKI$(A) : _
  1937.             CALL QTPUT1 ("Security changed to" + STR$(A)) : _
  1938.             CALL UPDTCALR ("Door reset security to "+STR$(A),2)
  1939.       GOTO 63105
  1940. 63115 IF LEN(A$(1)) < 7 THEN _
  1941.          GOTO 63105
  1942.       IF MID$(A$(1),3,1) <> "(" THEN _
  1943.          GOTO 63105
  1944.       X = INSTR(4,A$(1),":")
  1945.       IF X < 1 THEN _
  1946.          GOTO 63105
  1947.       CALL CHECKINT (MID$(A$(1),4,X-4))
  1948.       IF EC > 0 THEN _
  1949.          GOTO 63105
  1950.       IF TESTED.INTEGER.VALUE > 128 OR TESTED.INTEGER.VALUE < 1 THEN _
  1951.          GOTO 63105
  1952.       A = TESTED.INTEGER.VALUE
  1953.       CALL CHECKINT (MID$(A$(1),X+1))
  1954.       IF EC > 0 OR TESTED.INTEGER.VALUE < 1 OR TESTED.INTEGER.VALUE > 128 THEN _
  1955.          GOTO 63105
  1956.       MID$(USER.RECORD$,A,TESTED.INTEGER.VALUE) = LEFT$(A$(2) + _
  1957.          SPACE$(TESTED.INTEGER.VALUE),TESTED.INTEGER.VALUE)
  1958.       CALL UPDTCALR ("Door set UR"+STR$(A)+":"+STR$(TESTED.INTEGER.VALUE)+" to <"+A$(2)+">",2)
  1959.       GOTO 63105
  1960. 63195 CALL KILLWORK (FILE.NAME$)
  1961.       EC = 0
  1962.       END SUB
  1963. 63200 ' $SUBTITLE: 'WILDCARD -- Matches string to a pattern'
  1964. ' $PAGE
  1965. '  NAME    -- WILDCARD
  1966. '
  1967. '  INPUTS  -- PARAMETER             MEANING
  1968. '             PATTERN$           PATTERN TO CHECK
  1969. '             STRNG$             STRING TO FIE
  1970. '
  1971. '  OUTPUTS -- OK                 TRUE IF MATCH FOUND
  1972. '                                FALSE IF NO MATCH WAS FOUND
  1973. '
  1974. '  PURPOSE  Determine whether a string is an instance in a pattern
  1975. '           supported patterns are only "?" which requires a
  1976. '           character but can be any, and "*" which matches any-
  1977. '           thing, including a null string.  Anything else in a
  1978. '           sting must be an exact match.  Supports reverse
  1979. '           wildcards.
  1980. '
  1981. '
  1982.       SUB WILDCARD (PATTERN$,STRNG$) STATIC
  1983. 63285 OK = TRUE
  1984.       PATPOS = 0
  1985.       STRPOS = 0
  1986.       INC = 1
  1987.       KT = 0
  1988.       P = LEN(PATTERN$)
  1989.       L = LEN(STRNG$)
  1990. 63286 PATPOS = PATPOS + INC
  1991.       STRPOS = STRPOS + INC
  1992.       KT = KT + 1
  1993.       IF KT > L THEN _
  1994.          GOTO 63288
  1995.       B$ = MID$(PATTERN$,PATPOS,1)
  1996.       IF B$ = "*" THEN _
  1997.          GOTO 63289
  1998. 63287 IF B$ <> "?" AND MID$(STRNG$,STRPOS,1) <> B$ THEN _
  1999.          OK = FALSE : _
  2000.          EXIT SUB
  2001.       GOTO 63286
  2002. 63288 IF PATPOS >= LEN(PATTERN$) OR PATPOS < 1 THEN _
  2003.          EXIT SUB
  2004.       IF MID$(PATTERN$,PATPOS,1) <> "*" THEN _
  2005.          OK = FALSE : _
  2006.          EXIT SUB
  2007. 63289 IF PATPOS <> P THEN _   ' Reverse search
  2008.          INC = -1 : _
  2009.          P = PATPOS : _
  2010.          PATPOS = LEN(PATTERN$) + 1 : _
  2011.          STRPOS = LEN(STRNG$) + 1 : _
  2012.          KT = 0 : _
  2013.          GOTO 63286
  2014.       END SUB
  2015. 63300 ' $SUBTITLE: 'BRKFNAME - sub to split file name into components'
  2016. ' $PAGE
  2017. '
  2018. '  NAME    -- BRKFNAME
  2019. '
  2020. '  INPUTS  -- PARAMETER                    MEANING
  2021. '             FILENAME$        FULL NAME OF FILE
  2022. '             FOR.JOINING      TRUE IF WANT PARTS FORMATTED FOR
  2023. '                                           FORMING FILE NAMES
  2024. '  OUTPUTS -- DRVPATH$         DRIVE AND PATH
  2025. '             PREFIX$          PREFIX OF FILE NAME
  2026. '             EXTENSION$       EXTENSION OF FILE NAME
  2027. '
  2028. ' (E.G. "C:\RBBS\ARCE.COM" HAS "C:\RBBS" AS DRIVE AND PATH,
  2029. '                              "ARCE"    AS PREFIX OF THE FILE NAME, AND
  2030. '                              "COM"     AS THE EXTENSION OF THE FILE NAME.
  2031. '
  2032. ' JOINED FORMAT IS C:\RBBS\,ARCE,.COM
  2033. '
  2034. '  PURPOSE -- To break a file name into its component parts
  2035. '             of drive/path, prefix, and extension
  2036. '
  2037. '
  2038.       SUB BRKFNAME (FILENAME$,DRVPATH$,PREFIX$,EXTENSION$,FOR.JOINING) STATIC
  2039.       CALL ALLCAPS (FILENAME$)
  2040.       DRVPATH$ = ""
  2041.       PREFIX$ = ""
  2042.       EXTENSION$ = ""
  2043.       CALL TRIMTRAIL (FILENAME$,"\")
  2044.       L = LEN(FILENAME$)
  2045.       IF L < 1 THEN _
  2046.          EXIT SUB
  2047.       CALL FINDLAST (FILENAME$,"\",X,Y)
  2048.       IF X < 1 THEN _
  2049.          IF MID$(FILENAME$,2,1) = ":" THEN _
  2050.             DRVPATH$ = LEFT$(FILENAME$,1) : _
  2051.             S = 3 _
  2052.          ELSE S = 1 _
  2053.       ELSE DRVPATH$ = LEFT$(FILENAME$,X-1) : _
  2054.            S = X + 1 : _
  2055.            IF Y = 1 THEN _                                           ' KG061201
  2056.               DRVPATH$ = DRVPATH$ + "\"                              ' KG061201
  2057.       X = INSTR(FILENAME$ + ".",".")
  2058.       IF X < L THEN _
  2059.          EXTENSION$ = MID$(FILENAME$,X + 1,3)
  2060.       IF S <= L THEN _
  2061.          IF X >= S THEN _
  2062.             PREFIX$ = MID$(FILENAME$,S,X - S)
  2063.       IF NOT FOR.JOINING THEN _
  2064.          EXIT SUB
  2065.       IF LEN(DRVPATH$) = 1 THEN _
  2066.          IF DRVPATH$ <> "\" THEN _                                   ' KG061201
  2067.             DRVPATH$ = DRVPATH$ + _                                  ' KG061201
  2068.                        ":"                                           ' KG061201
  2069.       IF INSTR(DRVPATH$,"\") > 0 AND RIGHT$(DRVPATH$,1) <> "\" THEN _ ' KG061201
  2070.          DRVPATH$ = DRVPATH$ + _
  2071.                     "\"
  2072.       IF LEN(EXTENSION$) > 0 THEN _
  2073.          EXTENSION$ = "." + _
  2074.                       EXTENSION$
  2075.       END SUB
  2076. 63310 ' $SUBTITLE: 'RESTORECOM - sub to restore comm port'
  2077. ' $PAGE
  2078. '
  2079. '  NAME    -- RESTORECOM
  2080. '
  2081. '  INPUTS  -- none
  2082. '
  2083. '  OUTPUTS -- none
  2084. '
  2085. '  PURPOSE -- To restore communications port after an external
  2086. '             program may have left it in altered state
  2087. '
  2088.       SUB RESTORECOM STATIC
  2089.       PARITY$ = MID$(",N,8,1,E,7,1",7 + 6 * EIGHT.BIT,6)
  2090.       IF LOCAL.USER THEN _
  2091.          EXIT SUB
  2092.       CALL SETBAUD                                                   ' KG052102
  2093.       IF NOT FOSSIL THEN _                                           ' KG052102
  2094.          CALL OPENCOM(TALK.TO.MODEM.AT$,PARITY$)
  2095.       END SUB
  2096. 63320 ' $SUBTITLE: 'SHELLEXIT - sub to shell out from RBBS'
  2097. ' $PAGE
  2098. '
  2099. '  NAME    -- SHELLEXIT
  2100. '
  2101. '  INPUTS  -- SHELL.TEM$     String to invoke shell with
  2102. '
  2103. '  OUTPUTS -- none
  2104. '
  2105. '  PURPOSE -- Delay so that strings can finish printing.  Restore comm
  2106. '             port on return
  2107. '
  2108.       SUB SHELLEXIT (SHELL.TEM$) STATIC
  2109.       CALL DELAYIT (8 + BPS)
  2110.       IF FOSSIL THEN _
  2111.          CALL FOSEXIT(COMPORT%) _
  2112.       ELSE CLOSE 3 : _
  2113.            OUT MODEM.CONTROL.REGISTER,INP(MODEM.CONTROL.REGISTER) OR 1
  2114.       CLOSE 2
  2115.       CALL METAGSR (SHELL.TEM$,FALSE)
  2116.       SHELL SHELL.TEM$
  2117.       IF FOSSIL THEN _
  2118.          CALL FOSINIT(COMPORT%,RESULT%) : _
  2119.          IF RESULT% = -1 THEN _
  2120.             CALL PSCRN("ERROR INITIALIZING FOSSIL AFTER EXTERNAL PROTOCOL") : _
  2121.             SYSTEM
  2122.       CALL DELAYIT (2)
  2123.       CALL RESTORECOM
  2124.       END SUB
  2125. 63330 ' $SUBTITLE: 'READMACRO - sub to read macro'
  2126. ' $PAGE
  2127. '
  2128. '  NAME    -- READMACRO
  2129. '
  2130. '  INPUTS  -- PARAMETER             MEANING
  2131. '
  2132. '  OUTPUTS -- A$               LINE TO PROCESS IN MACRO
  2133. '             MACRO.ACTIVE     FLAG WHETHER IN A MACRO
  2134. '
  2135. '  PURPOSE -- Reads in a line from macro file (#6) and processes
  2136. '             macro commands, which are:
  2137. '             *0 - display what follows, no carriage return
  2138. '             *1 - display what follows with carriage return
  2139. '             *B - display block that follows
  2140. '             *F - display File
  2141. '             WT - wait specified # of seconds
  2142. '             >> - append following block to specified file
  2143. '             ST - stack following (with carriage return)
  2144. '             ON - define case
  2145. '             == - case value that applies to following block
  2146. '             M! - execute following macro
  2147. '             M@ - abort macro processing
  2148. '             EY - Echo on (yes)
  2149. '             EN - Echo off (no)
  2150. '             /* - comment line skipped in processing
  2151. '             TK - Turbo key on (if user preference)
  2152. '             << - Read from file into a form
  2153. '
  2154.       SUB READMACRO STATIC
  2155.       IF MACRO.TEMPLATE$ <> "" THEN _
  2156.          GOTO 63392
  2157.       IF DISTANT.TGET = 2 THEN _
  2158.          GOTO 63349
  2159. 63336 GOSUB 63395
  2160.       IF NOT MACRO.ACTIVE THEN _
  2161.          MACRO.ECHO = TRUE : _
  2162.          EXIT SUB
  2163.       IF LEN(A$) < 3 THEN _
  2164.          GOTO 63398
  2165.       X$ = RIGHT$(A$,LEN(A$)-3)
  2166.       IF COMPARE.VAR > 0 THEN _
  2167.          IF NOT CASE.EXECUTE THEN _
  2168.             IF LEFT$(A$,3) = SMART.TEXT$+"==" THEN _
  2169.                GOTO 63370 _
  2170.             ELSE IF LEFT$(A$,7) = "{END ON" THEN _
  2171.                     COMPARE.VAR = 0 : _
  2172.                     GOTO 63336 _
  2173.                   ELSE GOTO 63336
  2174.       IF LEFT$(A$,1) <> SMART.TEXT$ THEN _
  2175.          GOTO 63398
  2176.       CALL CHECKINT (MID$(A$,2))
  2177.       IF EC > 0 THEN _
  2178.          GOTO 63398
  2179.       IF TESTED.INTEGER.VALUE > 0 AND TESTED.INTEGER.VALUE <= MAX.WORK.VAR THEN _
  2180.          A$ = X$ : _  ' Macro command ask
  2181.          SUBROUTINE.PARAMETER = 4 : _
  2182.          CALL TPUT : _
  2183.          A$ = "" : _
  2184.          B$ = "" :_
  2185.          FORCE.KEYBOARD = TRUE : _
  2186.          MACRO.SAVE = TESTED.INTEGER.VALUE : _
  2187.          LINES.PRINTED = 1 : _
  2188.          NON.STOP = (PAGE.LENGTH < 1) : _                            ' KG072603
  2189.          EXIT SUB
  2190.       ON (1+INSTR("*0*1*B*FWT>>STON==M!M@EYEN/*TK<<",MID$(A$,2,2)))\2 GOTO _
  2191.          63345, _  ' Display with no Carriage Return
  2192.          63347, _  ' Display with Carriage Return
  2193.          63340, _  ' Display Block
  2194.          63348, _  ' Display File
  2195.          63343, _  ' Wait # of seconds
  2196.          63350, _  ' Append to file
  2197.          63355, _  ' Stack
  2198.          63360, _  ' Case
  2199.          63370, _  ' Case Comparison
  2200.          63375, _  ' Macro execute
  2201.          63380, _  ' Macro Abort
  2202.          63383, _  ' Macro Echo on
  2203.          63385, _  ' Macro Echo off
  2204.          63336, _  ' Macro Comment
  2205.          63387, _  ' Turbo Key allowed
  2206.          63390     ' Form read
  2207.       GOTO 63398
  2208. 63338 A$ = X$
  2209. 63339 SUBROUTINE.PARAMETER = 4                                       ' KG062803
  2210.       CALL TPUT
  2211.       RETURN
  2212. 63340 X$ = SMART.TEXT$ + "END"  ' Print Block
  2213.       GOSUB 63395
  2214.       WHILE MACRO.ACTIVE AND LEFT$(A$,4) <> X$
  2215.          GOSUB 63339
  2216.          CALL SKIPLINE (1)
  2217.          GOSUB 63395
  2218.       WEND
  2219.       GOTO 63336
  2220. 63343 CALL CHECKINT (X$)      ' Delay
  2221.       IF EC = 0 THEN _
  2222.          CALL DELAYIT (TESTED.INTEGER.VALUE)
  2223.       GOTO 63336
  2224. 63345 GOSUB 63338               ' Print Line
  2225.       GOTO 63336
  2226. 63347 GOSUB 63338
  2227.       CALL SKIPLINE (1)
  2228.       GOTO 63336
  2229. 63348 CALL TRIM (X$)            ' Print File
  2230.       CALL FINDITX (X$,7)                                            ' KG061001
  2231.       IF NOT OK THEN _
  2232.          GOTO 63336
  2233.       LINES.PRINTED = 1
  2234.       NO = FALSE                                                     ' KG071902
  2235.       NON.STOP = (NON.STOP OR PAGE.LENGTH < 1)                       ' KG060401
  2236. 63349 WHILE (NOT EOF(7) AND (NOT NO) AND (NON.STOP OR (LINES.PRINTED < PAGE.LENGTH)) AND (SUBROUTINE.PARAMETER > -1)) ' KG071904
  2237.          CALL READDIR (7,1)                                          ' KG061001
  2238.          GOSUB 63396                                                 ' KG060401
  2239.          SUBROUTINE.PARAMETER = 5
  2240.          CALL TPUT
  2241.       WEND
  2242.       DISTANT.TGET = 0
  2243.       IF SUBROUTINE.PARAMETER < 0 THEN _
  2244.          EXIT SUB
  2245.       IF EOF(7) OR NO THEN _                                         ' KG061001
  2246.          CLOSE 7 : _                                                 ' KG061001
  2247.          NO = FALSE : _                                              ' KG061001
  2248.          GOTO 63336
  2249.       DISTANT.TGET = 2
  2250.       CALL PAUSEEXIT
  2251.       EXIT SUB
  2252. 63350 EN$ = X$            ' Append to file
  2253.       X = INSTR(EN$," /FL")
  2254.       OVERSTRIKE = (X > 0)
  2255.       IF OVERSTRIKE THEN _
  2256.          EN$ = LEFT$(EN$,X-1) + RIGHT$(EN$,LEN(EN$)-X-3)
  2257.       CALL TRIM (EN$)
  2258.       CALL LOCKAPPND
  2259.       IF EC > 0 THEN _
  2260.          GOTO 63352
  2261.       GOSUB 63395
  2262.       X$ = SMART.TEXT$ + "END"
  2263.       WHILE MACRO.ACTIVE AND LEFT$(A$,4) <> X$                       ' KG062803
  2264.          CALL PRNTWRKA (A$)
  2265.          GOSUB 63395
  2266.       WEND
  2267. 63352 CALL UNLKAPPND
  2268.       OVERSTRIKE = FALSE
  2269.       GOTO 63336
  2270. 63355 COMMPORT.STACK$ = COMMPORT.STACK$ + X$ + CARRIAGE.RETURN$ ' STack
  2271.       GOTO 63336
  2272. 63360 COMPARE.VAR = VAL(X$)
  2273.       CALL ALLCAPS (X$)                                              ' KG062901
  2274.       IF COMPARE.VAR < 1 OR COMPARE.VAR > MAX.WORK.VAR THEN _
  2275.          COMPARE.VAR = 0
  2276.       GOTO 63336
  2277. 63370 IF COMPARE.VAR = 0 THEN _     ' Compare Case
  2278.          GOTO 63336
  2279.       DF$ = GSR.ARA$(COMPARE.VAR)
  2280.       CALL ALLCAPS (DF$)
  2281.       CASE.EXECUTE = (X$ = DF$)
  2282.       GOTO 63336
  2283. 63375 CALL TRIM (X$)           ' Execute Macro
  2284.       CALL CHKMACRO (X$,X)
  2285.       GOTO 63336
  2286. 63380 MACRO.ACTIVE = FALSE     ' Abort Macro
  2287.       GOTO 63398
  2288. 63383 MACRO.ECHO = TRUE
  2289.       GOTO 63336
  2290. 63385 MACRO.ECHO = FALSE
  2291.       GOTO 63336
  2292. 63387 TURBO.KEY = -TURBO.KEY.USER   'TK Turbo Key
  2293.       GOTO 63336
  2294. 63390 B$ = A$
  2295.       B$(5) = ""
  2296.       B$(6) = ""
  2297.       Q = 1
  2298.       STORE.PARSE.AT = 1                                             ' KG083101
  2299.       CALL PARSEIT
  2300.       IF Q < 4 THEN _
  2301.          GOTO 63336
  2302.       X$ = SMART.TEXT$ + "END"
  2303.       GOSUB 63397                                                    ' KG081006
  2304.       MACRO.TEMPLATE$ = ""
  2305.       WHILE MACRO.ACTIVE AND LEFT$(A$,4) <> X$
  2306.          MACRO.TEMPLATE$ = MACRO.TEMPLATE$ + A$ + CRLF$
  2307.          GOSUB 63397                                                 ' KG080302
  2308.       WEND
  2309.       X = VAL(B$(4))
  2310.       VAR.LEN = (B$(3) <> "/F")
  2311.       CALL FINDIT (B$(2))
  2312.       IF (X < 1) OR (NOT OK) OR (VAR.LEN AND X > MAX.WORK.VAR) THEN _
  2313.          MACRO.TEMPLATE$ = "" : _
  2314.          GOTO 63336
  2315. 63392 CALL FORMREAD (MACRO.TEMPLATE$,B$(2),NOT VAR.LEN,X,(B$(5) = "/FL"),(B$(6) = "/1"))
  2316.       IF MACRO.TEMPLATE$ <> "" THEN _
  2317.          EXIT SUB _
  2318.       ELSE GOTO 63336
  2319. 63395 GOSUB 63397                                                    ' KG080302
  2320.       GOSUB 63396                                                    ' KG080302
  2321.       RETURN                                                         ' KG080302
  2322. 63396 CALL SMARTTXT (A$,FALSE, OVERSTRIKE)
  2323.       CALL METAGSR (A$,OVERSTRIKE)
  2324.       RETURN
  2325. 63397 IF EOF(6) THEN _         ' Read next line in macro             ' KG080302
  2326.          MACRO.ACTIVE = FALSE _
  2327.       ELSE CALL READDIR (6,1) : _                                    ' KG080302
  2328.            MACRO.ACTIVE = (EC = 0)
  2329.       RETURN
  2330. 63398 END SUB    ' Not Macro command - pass to normal processing
  2331. 63400 ' $SUBTITLE: 'LOCKAPPND - prepares for file append'
  2332. ' $PAGE
  2333. '
  2334. '  NAME    -- LOCKAPPND
  2335. '
  2336. '  INPUTS  -- EN$            Name of file to append to
  2337. '
  2338. '  OUTPUTS -- none
  2339. '
  2340. '  PURPOSE -- Locks and opens file to append to
  2341. '
  2342.       SUB LOCKAPPND STATIC
  2343.       BX = &H4
  2344.       SUBROUTINE.PARAMETER = 9
  2345.       CALL FILELOCK
  2346.       EC = 0
  2347.       CALL OPENWRKA (EN$)
  2348.       END SUB
  2349. 63410 ' $SUBTITLE: 'UNLKAPPND - cleans up after file append'
  2350. ' $PAGE
  2351. '
  2352. '  NAME    -- UNLKAPPND
  2353. '
  2354. '  INPUTS  -- none
  2355. '
  2356. '  OUTPUTS -- none
  2357. '
  2358. '  PURPOSE -- Unlocks and close file appending to
  2359. '
  2360.       SUB UNLKAPPND STATIC
  2361.       BX = &H4
  2362.       SUBROUTINE.PARAMETER = 10
  2363.       CALL FILELOCK
  2364.       CLOSE 2
  2365.       END SUB
  2366. 63420 ' $SUBTITLE: 'FORMREAD - Reads from a file into a form'
  2367. ' $PAGE
  2368. '
  2369. '  NAME    -- FORMREAD
  2370. '
  2371. '  INPUTS  -- TEMPLATE$      Display formvoke shell with
  2372. '             FILNAME$       Data file to get values from
  2373. '             FIXED.LENGTH   Whether file is fixed length
  2374. '             DATA.VAR       # bytes data if fixed length; # fields
  2375. '                              if variable length
  2376. '             OVERSTRIKE     Whether typeover into form or insert
  2377. '             REC.PAUSE      Whether pause after every record displayed
  2378. '                               otherwise when screen fills
  2379. '  OUTPUTS -- (displays data base records)
  2380. '
  2381. '  PURPOSE -- Allows field oriented data base data to be displayed
  2382. '               in a human readable format by substituting field
  2383. '               data into template or form
  2384. '
  2385.       SUB FORMREAD (TEMPLATE$,FILNAME$,FIXED.LENGTH,DATA.VAR,OVERSTRIKE,REC.PAUSE) STATIC
  2386. 63422 IF EOF(2) OR NO OR (EC > 0) OR (SUBROUTINE.PARAMETER < 0) THEN _
  2387.          TEMPLATE$ = "" : _
  2388.          EXIT SUB
  2389.       IF FIXED.LENGTH THEN _
  2390.          CALL READDIR (2,1) : _
  2391.          GSR.ARA$(1) = A$ _
  2392.       ELSE CALL READPARMS (GSR.ARA$(),DATA.VAR,1)
  2393.       X$ = TEMPLATE$
  2394.       CALL SMARTTXT (X$,TRUE,OVERSTRIKE)
  2395.       CALL METAGSR (X$,OVERSTRIKE)
  2396.       CALL BUFASUNIT (X$)
  2397.       IF REC.PAUSE OR (PAGE.LENGTH > 0 AND (LINES.PRINTED >= PAGE.LENGTH-1)) THEN _
  2398.          CALL PAUSEEXIT : _
  2399.          EXIT SUB
  2400.       GOTO 63422
  2401.       END SUB
  2402. 63440 ' $SUBTITLE: 'BUFASUNIT - prints string with no pauses'
  2403. ' $PAGE
  2404. '
  2405. '  NAME    -- BUFASUNIT
  2406. '
  2407. '  INPUTS  -- STRNG$     String to print
  2408. '
  2409. '  OUTPUTS -- none
  2410. '
  2411. '  PURPOSE -- Prints string with embedded carriage returns.
  2412. '             Will never pause.  Used to print when can't call TGET
  2413. '
  2414.       SUB BUFASUNIT (STRNG$) STATIC
  2415.       L = LEN(STRNG$)
  2416.       IF L < 1 THEN _
  2417.          EXIT SUB
  2418.       START.BYTE = 1
  2419. 63450 CRAT = INSTR(START.BYTE,STRNG$,CARRIAGE.RETURN$)
  2420.       IF CRAT > 0 AND CRAT < L THEN _
  2421.          CR.FOUND = (MID$(STRNG$,CRAT + 1,1) = LINE.FEED$) _
  2422.       ELSE CR.FOUND = FALSE
  2423.       EOL.LEN = -2 * CR.FOUND
  2424.       IF CR.FOUND THEN _
  2425.          EOD = CRAT _
  2426.       ELSE EOD = L + 1
  2427.       NUM.BYTES = EOD - START.BYTE
  2428.       A$ = MID$(STRNG$,START.BYTE,NUM.BYTES)
  2429.       SUBROUTINE.PARAMETER = 4
  2430.       CALL TPUT
  2431.       CALL SKIPLINE (-(CR.FOUND))
  2432.       IF RET THEN _
  2433.          EXIT SUB
  2434.       START.BYTE = EOD + EOL.LEN
  2435.       IF START.BYTE <= L THEN _
  2436.          GOTO 63450
  2437.       END SUB
  2438. 63460 SUB MACROEXE (STRNG$) STATIC
  2439.       CALL TRIM (STRNG$)
  2440.       CALL FINDIT (STRNG$)
  2441.       IF NOT OK THEN _
  2442.          EXIT SUB
  2443.       COMMPORT.STACK$ = COMMPORT.STACK$ + STRNG$ + CARRIAGE.RETURN$
  2444.       CALL FDMACEXE
  2445.       END SUB
  2446. 63462 SUB FDMACEXE STATIC
  2447.       A$ = ""
  2448.       MACRO.ECHO = FALSE
  2449.       SUBROUTINE.PARAMETER = 4
  2450.       CALL TGET
  2451.       END SUB
  2452. 63465 SUB PAUSEEXIT STATIC
  2453.       ' CALL SKIPLINE (1)
  2454.       SUBROUTINE.PARAMETER = 4
  2455.       TURBO.KEY = -TURBO.KEY.USER
  2456.       A$ = MORE.PROMPT$ + ">" + MID$("? ! ",2*TURBO.KEY+1,2)
  2457.       FORCE.KEYBOARD = TRUE
  2458.       NO.ADVANCE = TRUE
  2459.       CALL TPUT
  2460.       LINES.PRINTED = 0
  2461.       B$ = ""                                                        ' KG060401
  2462.       END SUB
  2463. 63470 ' $SUBTITLE: 'CALLOPT - sub to set prompts based on user security'
  2464. ' $PAGE
  2465. '
  2466. '  NAME    -- CALLOPT
  2467. '
  2468. '  INPUTS  -- PARAMETER           MEANING
  2469. '             BEG.MAIN          POSITION START OF MAIN CMDS
  2470. '             BEG.FILE          POSITION START OF FILE CMDS
  2471. '             BEG.UTIL          POSITION START OF UTIL CMDS
  2472. '             BEG.LIBRARY       POSITION START OF LIBRARY CMDS
  2473. '
  2474. '  OUTPUTS -- PRESENT.OPTS$         DISPLAY WHAT USER CAN DO (1st)
  2475. '             CALLERS.OPTS$         DISPLAY WHAT USER CAN DO (2nd)
  2476. '             MAIN.OPTS$            MAIN OPTS USER CAN DO
  2477. '             FILE.OPTS$            FILE OPTS USER CAN DO
  2478. '             UTIL.OPTS$            UTIL OPTS USER CAN DO
  2479. '             LIBRARY.OPTS$         LIBRARY OPTS USER CAN DO
  2480. '
  2481. '  PURPOSE -- Sets command line display of what user can do by
  2482. '             section and display of what all user can do
  2483. '
  2484.       SUB CALLOPT STATIC
  2485.       FIRST = BEG.MAIN
  2486.       LAST = BEG.FILE - 1
  2487.       CALL SETOPTS (MAIN.OPTS$,INVALID.MAIN.OPTS$,FIRST,LAST)
  2488.       FIRST = BEG.FILE
  2489.       LAST = BEG.UTIL - 1
  2490.       CALL SETOPTS (FILE.OPTS$,INVALID.FILE.OPTS$,FIRST,LAST)
  2491.       FIRST = BEG.UTIL
  2492.       LAST = BEG.LIBRARY - 1
  2493.       CALL SETOPTS (UTIL.OPTS$,INVALID.UTIL.OPTS$,FIRST,LAST)
  2494.       FIRST = BEG.LIBRARY
  2495.       LAST = BEG.LIBRARY + 6
  2496.       CALL SETOPTS (LIBRARY.OPTS$,INVALID.LIBRARY.OPTS$,FIRST,LAST)
  2497.       FIRST = 50
  2498.       LAST = 56
  2499.       CALL SETOPTS (SYS.OPTS$,INVALID.SYS.OPTS$,FIRST,LAST)
  2500.       FIRST = 46
  2501.       LAST = 49
  2502.       CALL SETOPTS (GLOBAL.OPTS$,INVALID.GLOBAL.OPTS$,FIRST,LAST)
  2503.       IF LEN(SYS.OPTS$) > 0 THEN _
  2504.          SYSTEM.OPTS$ = "Sysop: " + _
  2505.                         SYS.OPTS$
  2506.       MAIN.OPTS$ = GLOBAL.OPTS$ + _
  2507.                    MAIN.OPTS$
  2508.       FILE.OPTS$ = GLOBAL.OPTS$ + _
  2509.                    FILE.OPTS$
  2510.       UTIL.OPTS$ = GLOBAL.OPTS$ + _
  2511.                    UTIL.OPTS$
  2512.       LIBRARY.OPTS$ = GLOBAL.OPTS$ + _
  2513.                       LIBRARY.OPTS$
  2514.       CALL SRTSTRNG (SYS.OPTS$)
  2515.       CALL SRTSTRNG (MAIN.OPTS$)
  2516.       MAIN.OPTS$ = MAIN.OPTS$ + _
  2517.                    SYS.OPTS$
  2518.       CALL SRTSTRNG (FILE.OPTS$)
  2519.       CALL SRTSTRNG (UTIL.OPTS$)
  2520.       CALL SRTSTRNG (LIBRARY.OPTS$)
  2521.       CALL INSCOMMA (MAIN.OPTS$)
  2522.       CALL INSCOMMA (FILE.OPTS$)
  2523.       CALL INSCOMMA (UTIL.OPTS$)
  2524.       CALL INSCOMMA (LIBRARY.OPTS$)
  2525.       DIR.PROMPT$ = "What directory(s) (" + _
  2526.          MID$("U)pload,A)ll,L)ist,E)xtended +/-, [Q]uit)",8 * (USER.SECURITY.LEVEL => MIN.SEC.TO.VIEW) + 9)
  2527.       QUIT.PROMPT.EXPERT$ = "QUIT C,S, or to F,[M],U,@"
  2528.       QUIT.PROMPT.NOVICE$ = "QUIT C)onference, S)ession or to section " + _
  2529.                             "F)ile, [M]ain, U)til or @)Library"
  2530.       QUIT.LIST$ = "FMUS@C"
  2531.       IF USER.SECURITY.LEVEL < OPT.SEC(18) THEN _
  2532.          QUIT.PROMPT.EXPERT$ = LEFT$(QUIT.PROMPT.EXPERT$,23) : _
  2533.          QUIT.PROMPT.NOVICE$ = LEFT$(QUIT.PROMPT.NOVICE$,61) : _
  2534.          MID$(QUIT.LIST$,5) = " "
  2535.       IF USER.SECURITY.LEVEL < OPT.SEC(15) THEN _
  2536.          QUIT.PROMPT.EXPERT$ = LEFT$(QUIT.PROMPT.EXPERT$,22) + _
  2537.                                MID$(QUIT.PROMPT.EXPERT$,25) : _
  2538.          QUIT.PROMPT.NOVICE$ = LEFT$(QUIT.PROMPT.NOVICE$,56) + _
  2539.                                MID$(QUIT.PROMPT.NOVICE$,63) : _
  2540.          MID$(QUIT.LIST$,3,1) = " "
  2541.       IF USER.SECURITY.LEVEL < OPT.SEC(6) THEN _
  2542.          QUIT.PROMPT.EXPERT$ = LEFT$(QUIT.PROMPT.EXPERT$,16) + _
  2543.                                MID$(QUIT.PROMPT.EXPERT$,19) : _
  2544.          QUIT.PROMPT.NOVICE$ = LEFT$(QUIT.PROMPT.NOVICE$,41) + _
  2545.                                MID$(QUIT.PROMPT.NOVICE$,49) : _
  2546.          MID$(QUIT.LIST$,1,1) = " "
  2547.       CALL SETSECT
  2548.       END SUB
  2549. 63480 ' $SUBTITLE: 'NOPATH - detects whether string has path'
  2550. ' $PAGE
  2551. '
  2552. '  NAME    -- NOPATH
  2553. '
  2554. '  INPUTS  -- STRNG$     String to check
  2555. '
  2556. '  OUTPUTS -- HAS.NONE   True if has no path
  2557. '
  2558. '  PURPOSE -- Detects whether have path.  Used when shouldn't
  2559. '             be any
  2560. '
  2561.       SUB NOPATH (STRNG$,HAS.PATH) STATIC                            ' KG060801
  2562.       CALL BRKFNAME (STRNG$,DRVPATH$,PREFX$,EXT$,FALSE)              ' KG060801
  2563.       HAS.PATH = (DRVPATH$ <> "")                                    ' KG060801
  2564.       END SUB                                                        ' KG060801
  2565. 63490 ' $SUBTITLE: 'FINDIT - Determine whether file exists'
  2566. ' $PAGE
  2567. '
  2568. '  NAME    -- FINDIT
  2569. '
  2570. '  INPUTS  -- FILNAME$   File name to check
  2571. '
  2572. '  OUTPUTS -- OK         True if file exists.  Opened as #2 if does
  2573. '
  2574. '  PURPOSE -- Determine whether file exists and open as standard work
  2575. '             file if it does (#2)
  2576. '
  2577.       SUB FINDIT (FILNAME$) STATIC                                   ' KG061001
  2578.       CALL FINDITX (FILNAME$,2)                                      ' KG061001
  2579.       END SUB                                                        ' KG061001
  2580. 63495 ' $SUBTITLE: 'TIMEBACK - Give time back to the user'           ' KG082701
  2581. ' $PAGE
  2582. '
  2583. '  NAME    -- TIMEBACK
  2584. '
  2585. '  INPUTS  -- INDEX    = 1    Set start of time (begin give back)
  2586. '                      = 2    Give back time from defined start
  2587. '
  2588. '  OUTPUTS -- TIME.CREDIT!          Number of seconds to credit with
  2589. '             SECONDS.PER.SESSION!  Number of seconds in current session
  2590. '
  2591. '  PURPOSE -- Give time back to the user (e.g. sysop initiated chat)
  2592. '
  2593.       SUB TIMEBACK (INDEX) STATIC                                    ' KG082701
  2594.       IF INDEX = 1 THEN _                                            ' KG082701
  2595.          CALL TIMEREMAIN (TIME.REMAINING!) : _                       ' KG082701
  2596.          Q! = TCA! : _                                               ' KG082701
  2597.          EXIT SUB                                                    ' KG082701
  2598.       CALL TIMEREMAIN (TIME.REMAINING!)                              ' KG082701
  2599.       X! = (TCA! - Q!)                                               ' KG082701
  2600.       TIME.CREDITS! = TIME.CREDITS! + X!                             ' KG082701
  2601.       SECONDS.PER.SESSION! = SECONDS.PER.SESSION! + X!               ' KG082701
  2602.       END SUB                                                        ' KG082701
  2603. 63500 ' $SUBTITLE: 'CSPUSHPOP - Save/restore command stack'          ' KG082702
  2604. ' $PAGE
  2605. '
  2606. '  NAME    -- CSPUSHPOP
  2607. '
  2608. '  INPUTS  -- INDEX    = 1    Save command stack
  2609. '                      = 2    Restore command stack
  2610. '             ANS.INDEX
  2611. '             LAST.INDEX
  2612. '             B$()
  2613. '
  2614. '  OUTPUTS -- B$()                  Stacked commands
  2615. '             ANS.INDEX
  2616. '             LAST.INDEX
  2617. '
  2618. '  PURPOSE -- Save restore a command stack list when need to input
  2619. '             another list in middle of previous list processing
  2620. '
  2621.       SUB CSPUSHPOP (INDEX) STATIC                                   ' KG082702
  2622.       IF INDEX = 1 THEN _                                            ' KG082702
  2623.          ORIG.LAST.INDEX = LAST.INDEX : _  ' save                    ' KG082702
  2624.          ORIG.INDEX = ANS.INDEX : _                                  ' KG082702
  2625.          FOR I = 1 TO ORIG.LAST.INDEX : _                            ' KG082702
  2626.              A$(I) = B$(I) : _                                       ' KG082702
  2627.          NEXT : _                                                    ' KG082702
  2628.          EXIT SUB                                                    ' KG082702
  2629.       LAST.INDEX = ORIG.LAST.INDEX        ' restore                  ' KG082702
  2630.       ANS.INDEX = ORIG.INDEX                                         ' KG082702
  2631.       FOR I = 1 TO ORIG.LAST.INDEX                                   ' KG082702
  2632.          B$(I) = A$(I)                                               ' KG082702
  2633.       NEXT                                                           ' KG082702
  2634.       END SUB                                                        ' KG082702
  2635.